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

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-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-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でとりあえず作ってみたという。

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

2013-01-25

VB(VBA)で数字を漢数字に変換する

 訳あって、「12 → 十二」のように数字を漢数字に変換する必要があったので、VBAで実装してみた。

 ちなみにExcelだとセル関数に「NUMBERSTRING関数」というものがあるらしく、最初からそれを使えば楽だったかな、と思わなくもなく。

 でも作ってしまったので、せっかくなので備忘録的に残しておく。

<注>

  • 「2010」は「二千十」にしかならず「二〇一〇」のような表記には対応していない。(必要なかったので)
  • 9999兆9999億9999万9999まで対応

 

Private Function convNumberToKanji(strNumber As String) As String
Dim intStart    As Integer
Dim intKeta     As Integer
Dim i           As Integer
Dim rtn         As String

    intStart = Len(strNumber)
    
    For i = intStart To 1 Step -1
        intKeta = intStart - i + 1
        rtn = getKanjiNumber(Mid(strNumber, i, 1), intKeta) & getKetaOfKanji(intKeta) & rtn
    Next
    
    convNumberToKanji = rtn
End Function


'数字(一桁)を漢字に変換
'(ただし「1」については「一千」のようには書かない仕様なので、1の位以外は漢数字なし)
Private Function getKanjiNumber(strNumber As String, intKeta As Integer) As String
    Select Case strNumber
        Case "1"
            If intKeta = 1 Then
                getKanjiNumber = "一"
            End If
        Case "2": getKanjiNumber = "二"
        Case "3": getKanjiNumber = "三"
        Case "4": getKanjiNumber = "四"
        Case "5": getKanjiNumber = "五"
        Case "6": getKanjiNumber = "六"
        Case "7": getKanjiNumber = "七"
        Case "8": getKanjiNumber = "八"
        Case "9": getKanjiNumber = "九"
    End Select
End Function


'桁の漢字表記を返す
Private Function getKetaOfKanji(intKeta As Integer) As String
    Select Case intKeta
        Case 1:     getKetaOfKanji = ""
        Case 2, 6, 9, 13:  getKetaOfKanji = "十"
        Case 3, 7, 10, 14: getKetaOfKanji = "百"
        Case 4, 8, 11, 15: getKetaOfKanji = "千"
        Case 5:     getKetaOfKanji = "万"
        Case 9:     getKetaOfKanji = "億"
        Case 12:    getKetaOfKanji = "兆"
    End Select
End Function

 これで

Sub test()
    MsgBox convNumberToKanji(任意の数字)
End Sub

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


 縦書き文化のお仕事だと、ちょこちょこ(年に1〜2回)必要になるのであった。

2012-10-17

Wordのルビに関するフィールドコード

故あって、ルビはフィールドコードでどう書かれるかを調べてみた

ルビの位置フィールドコード内容
中央揃え{EQ \* jc0 \* "Font:MS 明朝" \* hps10 \o(\s\up 9(ア),あ)}
均等割付1{EQ \* jc1 \* "Font:MS 明朝" \* hps10 \o\ad(\s\up 9(イ),い)}
均等割付2{EQ \* jc2 \* "Font:MS 明朝" \* hps10 \o\ad(\s\up 9(ウ),う)}
左揃え{EQ \* jc3 \* "Font:MS 明朝" \* hps10 \o\al(\s\up 9(エ),え)}
右揃え{EQ \* jc4 \* "Font:MS 明朝" \* hps10 \o\ar(\s\up 9(オ),お)}

並べてみると「jc○」の○のところと、「\o」に続く部分でルビの位置を指定しているらしい。

ただ、手元でテストしてみたところ、

  • 「jc○」の部分を手動で書き換えると「\o」に続く部分はそのままでもルビの位置が変わる
  • 「\o」に続く部分の部分を手動で書き換えても、「jc○」がそのままだとルビの位置が変わらない

という結果になった。


ちなみにフィールドコードを編集することで反対側(横書きの場合は下、縦書きの場合は左)にもルビを振ることができるのだが、ルビの位置は上下(縦書きの場合は左右)で共通の指定しかできないらしい。

そもそも調べ始めた理由は、2つのルビの位置を別々に指定できないか、という点だったので、ちょっと残念。

2011-08-19

列名から列Noを取得して返すFunctionを作ってみた

 「列Noから列名を取得して返すFunctionを作ってみた」に続いて、逆バージョンも作ってみた。

MsgBox getColumnNoFromColumnName("A")

とすると、「1」と表示される。

 引数として"Z"を与えれば「26」が返ってくるし、"AA"を与えれば「27」が返ってくる。

 ちなみにこのFunctionを作ろうと思ったきっかけは、

  • 管理画面では「列名」を指定したい
  • 管理画面で指定した列の○列右を指定したい

という事をしたかったから。

 そういうやり方が正しいのかどうか特に自信がある訳ではなく、もっと別なやり方もあるような気もするのだが、まぁ成長の過程の記録として記しておくことにする。

 誰かが使うかもしれないし。

'列名から列Noを取得して返す
Public Function getColumnNoFromColumnName(columnName As String) As Long
Dim i   As Integer
Dim tmp As Long

    For i = 1 To Len(columnName)
        tmp = tmp + ((Asc(Mid(columnName, i, 1)) - 64) * (26 ^ (Len(columnName) - i)))
    Next i
    
    getColumnNoFromColumnName = tmp
End Function

列Noから列名を取得して返すFunctionを作ってみた

 出先ではVB6とExcel VBAを駆使している私。

 いろいろあって「クリックしたセルの10列右」とかやりたい時がある。

 現在の列 = Activecell.Column

とやれば、アクティブなのがA列なら「1」が返ってくる。

 なので、例えば

 現在の列の10列右 = chr(Activecell.Column + 64 + 10)

とかやると、「K」が返ってくる。(64を足しているのは、Chr(65)が「A」だから)

 これはこれで良いのだが、Excelは「Z」列の右が「AA」列。

 仮にZ列のどこかを選択した状態で

 Z列の1列右 = chr(Activecell.Column + 64 + 1)

というのを実行すると、「[」が返ってきてしまう。

 文字コードの順番としてそうなっているのだから仕方ないと言えば仕方ない。

 そこで、列の番号を与えたらその列名を返してくれるFunctionを作ってみた。

 MsgBox getColumnNameFromColumnNo(1)

とやれば「A」と表示されるし、

 MsgBox getColumnNameFromColumnNo(Activecell.Column + 1)

とやれば、現在の列の1列右の列名を返してくれる。

 現在Z列がアクティブになっているなら、返ってくるのはもちろん「AA」だ。

 Excel2002まで対応したものは既に作成済みだったのだが、ここに書くにあたって手持ちのExcel2010の最大列「XFD」まで対応できるように作り直してみた。

 これが最善の方法とは思わないが、コピペで使いたい人もいるだろうから実用第一で置いておく事にする。

'列Noから列名を取得して返す
Public Function getColumnNameFromColumnNo(columnNo As Long) As String
Dim tmp As String
Dim i   As Long
Dim j   As Long
Dim k   As Long

    i = (columnNo - 1) \ 26
    If i > 0 Then
        k = (i - 1) \ 26
        If k > 0 Then
            tmp = Chr(64 + k)
            i = i Mod 26
            If i = 0 Then i = 26
        End If
        
        tmp = tmp & Chr(64 + i)
    End If
    j = columnNo Mod 26
    If j = 0 Then
        j = 26
    End If

    getColumnNameFromColumnNo = tmp & Chr(64 + j)
End Function

2008-05-12

Access98と2000でのVBAの挙動の違い (項目初期化)

Dim CatalogMaster As InData
    
    Open "c:\hoge\hogehoge.txt" For Random As #Fno Len = Len(CatalogMaster)

    Do Until EOF(Fno)
      Get #Fno, , CatalogMaster
      With CatalogMaster
        項目1 = Trim(.項目1)
        項目2 = Trim(.項目2)
        項目3 = Trim(.項目3)
      End With

    'この後に項目1〜3の内容チェックとDB登録

    Loop

※ InDataは標準モジュールとして定義済みとする


 Access98だとこの処理で問題なかったのだが、Access2000だとそれぞれの項目の末尾におかしなゴミが入ることがあった。

例: 「あいうえおかきくけこはひ」

正: 「あいうえおかきくけこ」


 データをチェックしてみたところ、どうやらそれよりいくつか前に「たちつてとなにぬねのはひ」というデータがあったらしい。

たちつてとなにぬねのはひ

…… 間に

…… いくつか

…… データがある

あいうえおかきくけこ

 要するに項目の初期化が上手くいってなくて、そこに前よりも文字数の少ない内容が入ると重なった感じの内容になってしまっていたらしい。必ずしも全パターンでそれが発生している訳でもなかったのがよく分からないのだが。

 とりあえずLoopの前に

      With CatalogMaster
        .項目1 = ""
        .項目2 = ""
        .項目3 = ""
      End With

を入れることで対処。

 次のデータを読み込めば前のデータは上書きされる気がするが、「初期化 → 上書き」(Access98)なのか「単なる上書き」(Access2000)なのかは大きな違いがあるという訳だ。

 そういえばプログラマ(COBOL/S)時代に「"初期化されるはず"と思わないで、明示的に初期化しろ」と教わったっけ。



 ちなみに元のコードは、自分の書いた訳ではないのであしからず。