兼業主夫 ときどき 指揮者 のち ギーク?

2017-01-24

Wordを扱う際にVBAとVBとの違いに戸惑わないための備忘録

VBでWordを操作する処理を作る際、Word VBAで動作を確認したものをVBに持ってくるというやり方を基本的にしている。

が、それだと上手く行かないことがあったので、ここに備忘録としてメモしておきたい。

例えばこれ。

<VBA>

Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend

単純に考えると、下記のような感じで動きそうな気がする。

Word.Selection.MoveLeft(wdCharacter, 1, wdExtend)

(「Microsoft.Office.Interop.Word」は、以下「Word」と表記)

でも動かない。

「'wdCharacter'は宣言されていません。アクセスできない保護レベルになっています」

「'wdExtend'は宣言されていません。アクセスできない保護レベルになっています」

と怒られてしまう。

ああそうか、と思って

Word.Selection.MoveLeft(Word.wdCharacter, 1, Word.wdExtend)

とやっても、

「'wdCharacter'は'Microsoft.Office.Interop.Word'のメンバーではありません」

「'wdExtend'は'Microsoft.Office.Interop.Word'のメンバーではありません」

と怒られる。

正解は

Word.Selection.MoveLeft(Word.WdUnits.wdCharacter, 1, Word.WdMovementType.wdExtend)

であった。

「wdCharacter」は「Microsoft.Office.Interop.Word.WdUnits」のメンバーであり、「wdExtend」は「Microsoft.Office.Interop.Word.WdMovementType」のメンバーという訳だ。

分かればどうという事はないけれど、ちょっと躓いたのでメモ。

2016-12-07

データの内容に応じてオートシェイプを配置していく

ちょっと聞かれたので、回答用にここにメモ。

「データ」シートに下記のようなデータがあるとする。

AB
1a2
2b3
3c2
4d4
5e1
6f6
7g3

このデータを読み取って、下記要領で「結果」シートに書き込みを行う。

  • 「データ」シートのB列の値を「結果」シートのD列に転記
  • データの転記は3行おき
  • 転記した値を元に、転記した行にオートシェイプを配置する
  • オートシェイプの幅は、転記した値に比例する

色々な書き方が当然あるだろうけれど、ざっくり作ってこんな感じでいかがでしょうか。

Sub main()
Dim row As Long

    row = 1
    
    With Sheets("データ")
        Do Until .Range("A" & row).Value = ""
            Call setShape(.Range("B" & row).Value, row)
            row = row + 1
        Loop
    End With
End Sub

Private Sub setShape(v As Long, dataRow As Long)
Dim shapeRow    As Long
Dim shapeTop    As Long
Dim shapeLeft   As Long
Dim ShapeWidth  As Long
Dim shapeHeight As Long

    shapeRow = ((dataRow - 1) * 3) + 1

    With Sheets("結果")
        shapeTop = .Range("E" & shapeRow).Top + 3
        shapeLeft = .Range("E" & shapeRow).Left + 5
        ShapeWidth = v * 10
        shapeHeight = 6.75
        
        .Range("D" & shapeRow).Value = v
        .Shapes.AddShape(msoShapeRectangle, shapeLeft, shapeTop, ShapeWidth, shapeHeight).Select
    End With
End Sub

なお、棒グラフ的なものを表示したいという場合には、Excel2007からは「データバー」という機能があるので、そちらを使うことをお勧めしておく。

2016-07-01

Chromeで起動時に毎回『拡張機能「○○」は自動的に削除されました。』の通知が出て困った場合の対処法

※ 2016/7/14 追記

その後、やはり当該メッセージが表示されてしまいました。

この方法だけでは当該メッセージの表示を止める事は出来ないようです。

----

以前Chromeに入れていた拡張機能「webページショット - Webpage Screenshot」が、ある時Chrome側で削除された(スパイウェアだったらしい)。

それは良いのだが、それ以降Chromeを起動する度に

拡張機能「webページショット - Webpage Screenshot」は自動的に削除されました。

というメッセージがいちいち表示されるようになった。

拡張機能の一覧を見ても、削除されているのでもちろん当該拡張機能は存在しない。

「Chrome 通知 削除されました」で検索してみると、「削除した拡張機能の確認が何度も表示される webページショット - Google プロダクト フォーラム」というページが見つかるのだが、試行錯誤のやり取りの結果、「これで解決するっぽい」と提示された手段は

  1. Chromeの設定→googleダッシュボードで同期データを全削除
  2. 同期の詳細設定を開いて再同期
  3. googleアカウントを切断
  4. ユーザーも全削除
  5. 再起動
  6. Chromeの設定にアカウントを入れて同期

というもの。

それで解決するならそれはそれで良いのだが、通知1つを消すためにかなりの労力である。

そこでさらにあれこれ調べていたところ、別の拡張機能だが通知を削除する手段を記したページを見つけた。

Chromeの拡張機能「Tab Position Customizer」を消す。

この手法を参考に、「webページショット - Webpage Screenshot」の場合は対象フォルダとファイル名を「ckibcdccnfeookdmbahgiakhnjcddpki」に読み替えると対処できる模様。

この文字列は、Chromeの設定にある拡張機能の一覧で確認できる拡張機能のIDなんだと思う。

消えてしまった以上、確認する術はないけれど。(検索すればネット上から発見できる可能性はある)

面倒な手法を採らずに済んで良かったので、誰かを助ける事もあるだろうからここにメモとして残しておく。

2016-06-06

VB(VBA)で、濁点半濁点が1文字になっているものを濁点半濁点付き文字に変換する

 必要に迫られて、というほど迫られてもいないけれど、念のための処理が必要になったので作った。

 「半角カナ」ではなく「全角カナ」になっている前提。

'全角2文字で入力されている濁点、半濁点を全角1文字に変換する(例:カ゛→ガ)
Function convZenkakuDakuten(str As String) As String
Dim tmp     As String
Dim str1    As String
Dim str2    As String
Dim i       As Integer

    tmp = Trim(str)

    str1 = "ガギグゲゴザジズゼゾダヂヅデドバビブベボ"
    str2 = "カキクケコサシスセソタチツテトハヒフヘホ"
    
    For i = Len(str1) To 1 Step -1
        tmp = Replace(tmp, Mid(str2, i, 1) & "゛", Mid(str1, i, 1))
    Next

    str1 = "パピプペポ"
    str2 = "ハヒフヘホ"
    For i = Len(str1) To 1 Step -1
        tmp = Replace(tmp, Mid(str2, i, 1) & "゜", Mid(str1, i, 1))
    Next
    
    tmp = Replace(tmp, "ウ゛", "ヴ")
    
    convZenkakuDakuten = tmp
End Function
Sub test()
    MsgBox convZenkakuDakuten(任意の文字列)
End Sub

のように呼び出して使う。

2014-09-11

いい加減なシステム会社のいい加減なソースをリファクタリングする

出先はシステム会社がVB6で作ったシステムを使っているのだが、あまりにシステム会社が駄目なので私が途中からソースを引き取って完成させたという代物。

今でも私がメンテナンス(機能追加など)を請け負っている。

どのくらいダメかと言うと、

  • 何度かの打ち合わせを経て先方から「開発期間は2007年12月〜2008年3月、リリースは2008年4月1日」というスケジュールを提示されたのに、リリース日時点で(今から考えれば)30%程度しか出来ていなかった
  • 仕様の確認が甘く「そうじゃない」と指摘する事案が多発*1
  • 2010年1月時点でも完成度が70%ほどだった

結局2010年2月から私が開発を引き継いで根幹部分をほぼ作り直したりしながら完成させたのだが、それでも正しく動いているところは基本的にそのまま使っていた。

で、今回チェック機能を追加しようとして当該箇所のソースを見てうーむ。

続きを読む

*1:音楽CDのデータを扱うと分かっているのに、「B'z」と入れるとアポストロフィのエスケープが行われていないためDBエラーで落ちる、など

2014-08-25

VB6やVBAで「長押し」処理を実装する

未だにVB6で作られたシステムを保守している。(保守と言っても、機能追加なども普通にある)

ちなみに私が作ったものではないが、種々の事情により完全に私の管理物であり、5年ほどの間にもはや私が作ったと言っても過言ではないくらいリファクタリングした。

そのシステムで「長押ししたらクリップボードにコピー」という処理を実装しようとして躓いたのでメモ。

何に躓いたかと言うと、MouseDownイベントは押しっぱなしの間ずっと発生し続けているのかと思ったら、どれだけ長押ししようと1回しかイベント発生しないのね、という点。

ネットであれこれ見てもしっくりくるものがなかったので、自作してみた。

Private mouseDownEndTime As Double  'この時間まで押されていたら「長押し」と判断

Private Sub コントロール_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseDown(コントロール)
End Sub

Private Sub コントロール_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseUp(コントロール)
End Sub

'マウスが長押しされた場合に、処理を実行する
Private Sub ctrlMouseDown(ctrl As Control)
    mouseDownEndTime = getTimer() + 1   'この場合は1秒間長押ししたら処理実行
    
    Do Until mouseDownEndTime < getTimer() Or mouseDownEndTime = 0
        DoEvents  'これがないとDo Untilで回っている間のMouseUpを検知しない
    Loop
    
    If mouseDownEndTime > 0 Then  '時間が経過する前にMouseUpしていたらここがゼロなので処理を行わない

        'ここに長押し時に実行したい処理を書く

    End If
    
    mouseDownEndTime = 0
End Sub

Private Function getTimer() As Double
    getTimer = CDbl(Timer)
End Function

Private Sub ctrlMouseUp(ctrl As Control)
    mouseDownEndTime = 0
End Sub

長押し時に実行したい処理がコントロール要素と特に関係ないのであれば、引数としてコントロールを渡さなくても構わない。

私は「コントロール要素の中身をクリップボードにコピーする」という処理を入れたかったので渡しているけど。

ちなみに、VBAにはないけどVB6にはあるコントロールの配列の場合は、MouseDownとMouseUpの書き方が下記のような感じになる。(私が今回使ったのはこっち)

Private Sub コントロール_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseDown(コントロール(Index))
End Sub

Private Sub コントロール_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)
    Call ctrlMouseUp(コントロール(Index))
End Sub

2014-08-18

どこにも需要がない「今が何回戦なのかを返すFunction」を考えた

トーナメント戦を扱うと、1回戦、2回戦、3回戦と進んでいくのは分かりやすいのだが、どこかで「準々決勝」「準決勝」「決勝」と表記しなければならない。

1回戦から順番に数えると6回戦なんだけど、一般的な呼称は「準決勝」のような場合。

そこで、「単純に数えて今何回戦なのか」と「出場チーム数」を渡してやれば、「○回戦」あるいは「準々決勝」「準決勝」「決勝」のような表記を返してくれるFunction「getRoundName」を考えてみた。

Private Function getRoundName(intRound As Integer, schools As Integer) As String
Dim maxRound    As Integer
Dim rtn         As String

    maxRound = getMaxRound(schools)
    
    Select Case intRound
    Case maxRound
        rtn = "決勝"
    Case maxRound - 1
        rtn = "準決勝"
    Case maxRound - 2
        rtn = "準々決勝"
    Case Else
        rtn = intRound & "回戦"
    End Select
    
    getRoundName = rtn
End Function

'決勝なども含めて「最大何回戦相当まであるか」を取得して返す
Private Function getMaxRound(schools As Integer) As Integer
Dim i       As Integer
Dim j       As Integer
    
    i = 1
    Do While i < schools
        i = i * 2
        j = j + 1
    Loop
    
    getMaxRound = j + 1
End Function

下記のような感じで使用する。

Sub test()
Dim schools As Integer
    
    schools = 49
    
    MsgBox getRoundName(6, schools)
End Sub

で、実際にはVBAで処理している訳ではないのだけれど、Excelで手軽に確認できるからVBAでとりあえず作ってみたという。

何しろ出先なので……。 ← 暇だったらしい

2014-08-04

本番環境とテスト環境でDebugKitを使うかどうかを切り替える

DebugKitが本番環境でも有効なのは困るので、「CakePHPでデバック用プラグイン「DebugKit」を使用する方法 | 【鋭利団体】PK-Brothers」の「開発時のみ有効となる設定を追加」を参考にして設定した。

よくある導入解説だと「AppController.php」の「$uses」に「DebugKit.Toolbar」を追加することになっているのだが、上記方法であればこの手順は不要である。

ページネーションの実装について

管理者メニューで登録ユーザの一覧が見られるといいな、と思ったので、実装した。

その際に、CakePHPのページネーション機能を使ったのだが、下記サイトが分かりやすかったのでメモ。

ページネーションを利用する | CakePHP2.1初心者メモ

2014-07-30

jQueryのeachを逆順で実行する

表の列に連番を降順で振りたい場合、要素数が一定でない場合にどうすれば良いのか。

検索して「jQueryのeachメソッドの逆 - プログラマ的京都生活」を参考にした。

ざっくり言えば、

$($('#sel').children(':selected').get().reverse()).each(function(){
  処理
});

とすれば良いらしい。

これで「処理」内に「i++]でカウントアップしながら連番を振れば、画面上は連番が降順で振られる。

2014-07-29

VARCHAR型に入れた日本語が、phpMyAdmin上で見ると文字化けしていた件

web帳 | CentOS MySQL5.6 文字コード設定」を参考にした。

MySQLのバージョンが新しいと

× default-character-set=utf8

○ character-set-server = utf8

なので注意が必要。(ネットで情報を探すと、今現在は前者が検索によく引っかかる)。