Environメソッドというものがある

Environメソッドというものがある

Wordの〝標準テンプレート〟ファイル(Normal.dotm)を、VBAでゴニョゴニョしたい、ということがあったとする。

その場合、当然ながら標準テンプレートファイルのあるディレクトリのパスを取得する必要がある。

自分一人しか使わないマクロだったら、単純にパスをジカ打ちすりゃいい。

たとえば、私の環境なら、

C:\Users\admin\AppData\Roaming\Microsoft\Templates

これでいい。

問題は、いろいろな端末で使い回すマクロの場合である。

何せ、上記のパスのうち、「admin」の部分は、ユーザによって異なるからである!

環境変数を使おう!

そういうときは、〝環境変数〟の出番ですよ!

たとえば、上記パスのうち、

C:\Users\admin\AppData\Roaming

の部分は、環境変数 %AppData% に格納されている。

だから、エクスプローラーのアドレス バーに

%AppData%\\Microsoft\Templates

と打ち込んで、

[Enter]を押してやれば、

ほれ。この通り、無事にTemplatesフォルダに移動できる。

環境変数をそのままVBAに渡してもダメ

ただし、環境変数をそのままVBAに渡しても、VBAはそれをパスとして解読してはくれない。

こうなる。

Environメソッドを使う

環境変数に格納された値を取得するには、VBA.InteractionクラスのEnvironメソッドを用いれば良いのである。(参考

このように、

C:\Users\admin\AppData\Roaming

という文字列を取得できるのである。

この通り、無事にTemplatesフォルダのパスが取得できた。

おわりに

職場で使い回すようなマクロを作るときは、〝環境変数〟というものを意識するのもいいかもしれませんね。

参考

「分かりそう」で「分からない」でも「分かった」気になれるIT用語辞典

ChatGPTにコードをレビューしてもらう

ChatGPTにコードレビューをしてもらう

自作MakeUserSickメソッドを改良(?)する

今話題のChatGPTにコードを投げると、コードレビューしてもらえる。

孤独なVBAマンには実にありがたい。

そこで、わが最高傑作(?)、MakeUserSickメソッドを少し改良(?)して、ChatGPT先生に見てもらうことにした。

……と、ここまでフツーに「ChatGPT」などと表記してきたが、実は「GPT」だったか「GPI」だったか、思い出せなくなっていたので、先に尋ねておいたのである。

MakeUserSickメソッドの改良

元のMakeUserSickメソッドはコチラ

早速、改良(?)後のコードをお目に掛けよう。

リスト1
Public Enum MsgBoxStyle
  mbsOkOnly = vbOKOnly
  mbsOkCancel = vbOKCancel
  mbsCritical = vbCritical
  mbsExclamation = vbExclamation
  mbsInformation = vbInformation
  mbsQuestion = vbQuestion
  mbsYesNo = vbYesNo
  mbsYesNoCancel = vbYesNoCancel
End Enum

'///ち~んw用'
Private Const MAKE_USER_SICK_2013 As String = _
              "       _______" & vbCrLf & _
              "   /       \" & vbCrLf & _
              "/ /・\  /・\ \" & vbCrLf & _
              "|   ̄ ̄    ̄ ̄   |   ち~んw" & vbCrLf & _
              "|    (_人_)   |" & vbCrLf & _
              "|     \  |   |" & vbCrLf & _
              "\     \_|  /"

Private Const MAKE_USER_SICK_2010 As String = _
              "     _______" & vbCrLf & _
              " /               \ " & vbCrLf & _
              "/ /・\  /・\     \" & vbCrLf & _
              "|   ̄ ̄    ̄         | ち~んw" & vbCrLf & _
              "|    (_人_)       |" & vbCrLf & _
              "|     \     |          |" & vbCrLf & _
              "\      \_|       /"

'///ユーザーを煽るAAを表示する'
Public Function MakeUserSick( _
               Optional ByVal a_Message As String, _
               Optional ByVal a_Style As MsgBoxStyle, _
               Optional ByVal a_Title As String) As VbMsgBoxResult
  Dim ret As VbMsgBoxResult
  ret = vbCancel
  If a_Message = "" Then a_Message = "涙拭けよwww"
  Dim ver As String
  ver = Application.Version
  Dim tmp As String
  Select Case ver
    Case "14.0"
      tmp = MAKE_USER_SICK_2010
    Case "15.0"
      tmp = MAKE_USER_SICK_2013
    Case "16.0"
      tmp = MAKE_USER_SICK_2013
    Case Else
      tmp = MAKE_USER_SICK_2010
  End Select
  ret = MsgBox(prompt:=a_Message & vbCrLf & tmp, _
               Buttons:=a_Style, _
               Title:=a_Title)
  MakeUserSick = ret
End Function

旧ヴァージョンは、Subだったが、今度のやつはFunctionである!

ユーザーを軽く煽った上で、ユーザーの意思を確認することまでできるニクいやつになったのである!

まあ、そんなことはどうでもよろしい。

さっそくChatGPT先生にレビューしてもらおう。

ChatGPT先生にレビューをお願いする

これは実に簡単。

コードを丸ごと貼り付けて、最後に「このコードをレビューしてください。」と付け加えるだけ。

まっ たく 簡 単 だ。

ChatGPT先生のお答え

テキストでも引用しておく。

このコードは、VB.NETで書かれたMsgBox関数を使用したカスタムのメッセージボックス機能を実装しています。以下は、このコードのレビューです。


  • 列挙型(Enum)MsgBoxStyleが定義されており、MsgBoxで使用できる定数を指定しています。これにより、MsgBoxの呼び出し時に可読性が向上し、コードの意図を明確にすることができます。
  • メッセージボックスに表示するAAアートを定数として定義し、MakeUserSick関数で使用されています。これにより、ユーザーに強烈な印象を与えることができますが、実際のアプリケーションで使用する場合は注意が必要です。ユーザーに不快感を与える可能性があります。
  • メッセージ、スタイル、タイトルを引数として取り、MsgBoxを呼び出します。MsgBoxの戻り値は、MakeUserSick関数の戻り値として使用されます。
  • MakeUserSick関数の戻り値の型は、VbMsgBoxResultとして指定されています。これは、MsgBox関数の戻り値と同じ型です。
  • ユーザーが何も入力しなかった場合に備えて、デフォルトのメッセージが設定されています。
  • アプリケーションのバージョンに応じて、異なるAAアートが使用されます。アプリケーションのバージョンが14.0の場合は、2010年のAAアートが使用されます。15.0と16.0の場合は、2013年のAAアートが使用されます。これは、AAアートがバージョンによって異なる可能性があるためです。

このコードは、カスタムのメッセージボックス機能を実装するための簡潔で効果的な方法です。ただし、ユーザーに不快感を与える可能性があるAAアートを使用する場合は、注意が必要です。また、アプリケーションのバージョンに依存する処理が含まれているため、将来的にバージョンアップする場合は、注意してコードを修正する必要があります。

ところどころトンチキなことも言っているが、まあまあ正確なレビューなんではなかろうか。

特に、「ユーザーに不快感を与える」というところなんか、正直すげえなあ、と思う。

おわりに

自作のコードをいろいろ投げてみたら、おもしろいですよ。

【覚書】[Shell32.Shell].Namespaceメソッドの引数でハマった話

【覚書】Shell32.Shell.Namespaceメソッドの引数でハマった話

結論だけ手っ取り早く知りたい方はコチラ

何があったのか

事の発端:Shell32.Shellオブジェクトを使うマクロ

かつて、

akashi-keirin.hatenablog.com

こんなネタを書いていた。

レイト・バインディング風味に書き換え

この頃はアーリー・バインディング派だったので、当然のようにバリバリ(死語)に参照設定をして、Newしまくってイキっていた。

しかし、時は巡り、また夏が来て……を繰り返しているうち、すっかり考え方も変わり、今ではバリバリ(死語)のレイト・バインディング派になったのである!

そこで、参照設定を外して、レイト・バインディング風にコードを書き換えたのである。

リスト1 書き換え前
'宣言セクション'
'Microsoft Scripting Runtime参照設定'
'Microsoft Shell Controls And Automation参照設定'
Private m_FSO As New Scripting.FileSystemObject
Private m_Shell As New Shell32.Shell

Public Function SetLastModifiedDateTime( _
            ByVal a_Path As String, _
            ByVal a_DateTime As Date) As Boolean
  SetLastModifiedDateTime = False
  On Error GoTo HandleError
  'Scripting.Fileオブジェクトを取得'
  Dim tgtFile As Scripting.File
  Set tgtFile = m_FSO.GetFile(a_Path)
  'フォルダパスを取得'
  Dim tgtDir As String
  tgtDir = tgtFile.ParentFolder.Path
  'フォルダを取得'
  Dim tgtFolder As Shell32.Folder
  Set tgtFolder = m_Shell.Namespace(tgtDir)
  'ファイルを取得'
  Dim tgtItem As Shell32.FolderItem
  Set tgtItem = tgtFolder.ParseName(tgtFile.Name)
  '更新日時をセット'
  tgtItem.ModifyDate = a_DateTime
  setLastModifiedDateTime = True
  Exit Function
HandleError:
  Call Err.Clear
End Function

ブログを書いた頃に比べると、少しコーディング・スタイルが変わっているぞ。

スト2 書き換え後
'宣言セクション'
Private m_FSO As Object
Private m_Shell As Object

Public Function SetLastModifiedDateTime( _
                ByVal a_Path As String, _
                ByVal a_DateTime As Date) As Boolean
  SetLastModifiedDateTime = False
  On Error GoTo HandleError
  If m_FSO Is Nothing Then
    Set m_FSO = CreateObject("Scripting.FileSystemObject")
  End If
  If m_Shell Is Nothing Then
    Set m_Shell = CreateObject("Shell.Application")
  End If
  'Scripting.Fileオブジェクトを取得'
  Dim tgtFile As Object
  Set tgtFile = m_FSO.GetFile(a_Path)
  'フォルダパスを取得'
  Dim tgtDir As String
  tgtDir = tgtFile.ParentFolder.Path
  'フォルダを取得'
  Dim tgtFolder As Object
  Set tgtFolder = m_Shell.Namespace(tgtDir)
  'ファイルを取得'
  Dim tgtItem As Object
  Set tgtItem = tgtFolder.ParseName(tgtFile.Name)
  '更新日時をセット'
  tgtItem.ModifyDate = a_DateTime
  SetLastModifiedDateTime = True: Exit Function
HandleError:
  Call Err.Clear
End Function

悲劇:なぜかエラーが出る

これで万全! ……のはずである。

しかし、標題の通り、なぜかエラーに見舞われるのである。

この通り、

Set tgtFolder = m_Shell.Namespace(tgtDir)

で、[Shell32.Shell].NamespaceメソッドがNothingを返すために、次の

Set tgtItem = tgtFolder.ParseName(tgtFile.Name)

がエラーになってしまうのである!

これは全然意味がわからんぞ!

救いの神現る

……てなことを、Twitterでぼやいていたら、来ましたよ。

まさか、引数の型が原因だったとは。

さらに書き換え

そこで、コードを書き換える……といっても、書き換えるのは1行だけですが!

リスト3 さらに書き換え後
'宣言セクション'
Private m_FSO As Object
Private m_Shell As Object

Public Function SetLastModifiedDateTime( _
                ByVal a_Path As String, _
                ByVal a_DateTime As Date) As Boolean
  SetLastModifiedDateTime = False
  On Error GoTo HandleError
  If m_FSO Is Nothing Then
    Set m_FSO = CreateObject("Scripting.FileSystemObject")
  End If
  If m_Shell Is Nothing Then
    Set m_Shell = CreateObject("Shell.Application")
  End If
  'Scripting.Fileオブジェクトを取得'
  Dim tgtFile As Object
  Set tgtFile = m_FSO.GetFile(a_Path)
  'フォルダパスを取得'
  Dim tgtDir As String
  tgtDir = tgtFile.ParentFolder.Path
  'フォルダを取得'
  Dim tgtFolder As Object
  Set tgtFolder = m_Shell.Namespace(CVar(tgtDir)) '……(*)'
  'ファイルを取得'
  Dim tgtItem As Object
  Set tgtItem = tgtFolder.ParseName(tgtFile.Name)
  '更新日時をセット'
  tgtItem.ModifyDate = a_DateTime
  SetLastModifiedDateTime = True: Exit Function
HandleError:
  Call Err.Clear
End Function

変えたのは、(*)のところだけ。

要するに、フォルダパスの文字列をVariant型にキャストして[Shell32.Shell].Namespaceメソッドに渡しただけ。

これでエラーが出なくなった。

おわりに

レイト・バインディング方式で、[Shell32.Shell].Namespaceメソッドを使うときには、引数をVariant型で渡しましょう!

ちなみに、コチラのページでも、

Shell.NameSpace( _
  ByVal vDir As Variant _
) As Folder

と書いてある(「vDir」)ので、引数はVariant型、ということなのでしょう。

久々に小ハマリした報告でした。

Rangeオブジェクトの場所を目立たせるマクロ(Word)

Rangeオブジェクトの場所を目立たせるマクロ(Word)

WordのRangeオブジェクトの場所はわかりにくい

WordのVBAでマクロを作っているとき、地味に困るのが、

Rangeオブジェクトがどこを指し示しているのかわからん問題

である!

Steven Romanさん、ありがとう!

Writing Word Macros』(Steven Roman・1999年・O'REILLY)という書籍がある。

その中で、実に面白いマクロが紹介されていたので、お目にかけよう!

Rangeオブジェクトの箇所を目立たせるマクロ

上掲書に載っていたコードを、一部改変。

リスト1
Public Sub BlinkRange(ByVal a_Range As Range, _
                      ByVal a_Time As Single, _
                      ByVal a_Blink As Boolean)
  Dim startTime As Variant
  Dim tickTime As Variant
  'Safety net'
  If a_Range Is Nothing Then Exit Sub
  If a_Time < 0.1 Or a_Time > 60 Then
    a_Time = 2
  End If
  'Emboss range'
  a_Range.Font.Emboss = True
  'Wait a_Time seconds, blinking  '
  'every 0.25 seconds if requested'
  startTime = Timer()
  tickTime = startTime
  Do
    DoEvents
    If a_Blink Then
      If Timer() - tickTime > 0.25 Then '……(*)'
        With a_Range.Font
          .Emboss = Not .Emboss
          tickTime = Timer()
        End With
      End If
    End If
  Loop Until Timer() - startTime >= a_Time
  'Kill emboss'
  a_Range.Font.Emboss = False
End Sub

見ての通り、RangeオブジェクトのFontプロパティから当該箇所のFontオブジェクトを取得し、そのEmbossプロパティをTrueにすることによって、第2引数a_Timeで指定した時間、当該箇所を目立たせる、というもの。

ちなみに、第3引数のa_BlinkTrueにしてあると、(*)からの6行、

If Timer() - tickTime > 0.25 Then '……(*)'
  With a_Range.Font
    .Emboss = Not .Emboss
    tickTime = Timer()
  End With
End If

が発動することにより、あたかも当該箇所が点滅しているかのごとく、派手な演出となる。

動かしてみる

このような文書を用意する。カーソルは、「開催・運営」という段落の先頭にある。

この状態で、次のリスト2を実行する。

スト2
Private Sub test02()
  Dim tgtRng As Range
  Set tgtRng = Selection.Range.Next(wdParagraph, 1)
  Call BlinkRange(tgtRng, 3, True)
End Sub

(プロシージャ名「test02」の「02」に深い意味はありません。)

[Range].Nextメソッドで、カーソル位置のある場所(Selection.Range)の次の段落の部分をRangeオブジェクトとして取得し、そのRangeオブジェクトをBlinkRangeメソッドに渡す。

第2引数が「3」なので3秒間、第3引数が「True」なので当該箇所を点滅させることになる。

すると、

こうなる。

Selectメソッドを使ったわけではないので、カーソル位置は当然

元のまま。

おわりに

マクロ作成中の動作確認時とか、デバッグ時に、Debug.Printのように使えば、はかどるのではないでしょうか。

隠し文字を検索してカーソルを移動する(Word)

隠し文字を検索してカーソルを移動する(Word)

隠し文字は表示しないと検索に引っかからない

隠し文字は、編集画面上で非表示になっていると、Findオブジェクトを用いた検索に引っかからない。(もちろん、ふつうに検索ダイアログボックスを用いて検索しても引っかからない。)

だから、隠し文字のところを目印に、カーソルを移動させるには、ひと工夫が要る。

  • 一旦、非表示の隠し文字を表示する。
  • 検索する。
  • 選択状態のカーソルを潰す。
  • 隠し文字を非表示に戻す。

とまあ、こんな具合。

隠し文字を検索してRangeを返すFunction

まず、任意の隠し文字を検索して、ヒットしたらその箇所のRangeを返し、ヒットしなかったらNothingを返すFunctionを作る。

リスト1
Private Function getNextHiddenTextRange( _
                 ByVal a_Text As String) As Range
  Dim ret As Range
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  With Selection.Find
    .Format = True    '……(*)'
    .Font.Hidden = True    '……(**)'
    .Text = a_Text
    .Replacement.Text = ""
    .Wrap = wdFindStop
    .MatchFuzzy = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
  End With
  Call Selection.Find.Execute
  If Not Selection.Find.Found Then GoTo ReturnObject
  Set ret = Selection.Range
ReturnObject:
  With Selection.Find
    .Format = False
    .Font.Hidden = False
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  Set getNextHiddenTextRange = ret
End Function

例によって異様にタテ長になってしまうのは、Findオブジェクトの宿命。

ポイントは、(*)(**)のところ。

Find.FormatプロパティをTrueにすることで、書式情報をも検索対象に入れることができる。

そうしておいた上で、Find.HiddenプロパティをTrueにする。

このようにすることで、隠し文字になっている文字列のみ、検索対象とすることができる。

これで、検索でヒットしたらその箇所のRangeが返るし、ヒットしなければNothinが返ることになる。

ただし、気をつけねばならんことが一つ。

ヒットした場合は、当該の箇所が選択された状態になっている、ということである。

任意の隠し文字のある箇所にカーソルを置くFunction

たとえば、隠し文字を表示した状態で、次のようになっている文書があるとする。

隠し文字を非表示にすると、

こうなる。

この状態で、「競輪用自転車」という見出しの先頭にカーソルを移動させたいのである。

スト2
Public Function SetCursorEndOfHiddenText( _
                ByVal a_HiddenText As String) As Boolean
  SetCursorEndOfHiddenText = False
  Dim tgtRng As Range
  Dim isHidden As Boolean '最初の表示・非表示を記録するフラグ'
  With Application.ActiveWindow.View
    If .ShowAll Then GoTo ExitHere1
    If Not .ShowHiddenText Then
      '隠し文字非表示の場合、一旦表示にして元の状態を覚えておく'
      .ShowHiddenText = True
      isHidden = True
    End If
  End With
ExitHere1:
  Set tgtRng = getNextHiddenTextRange(a_HiddenText)
  If tgtRng Is Nothing Then GoTo ExitHere2
  Call tgtRng.Select
  Call Selection.Collapse(wdCollapseEnd)    '……(*)'
  SetCursorEndOfHiddenText = True
ExitHere2:
  With Application.ActiveWindow.View
    If Not .ShowAll Then
      'もともと非表示だった場合は非表示に戻す'
      If isHidden Then .ShowHiddenText = False
    End If
  End With
End Function

隠し文字の表示設定を実行前の状態に戻す、という仕様にしたので、その分だけコードが長くなっているが、メインの処理は至って簡単。

隠し文字が非表示だったら表示させた上で、先のリスト1getNextHiddenTextRangeメソッドを用いて対象の隠し文字を検索し、ヒットしたら選択範囲を後方に潰して((*)のところ。)、隠し文字の表示設定を元に戻しているだけ。

選択範囲を後方に向けて潰すのは、このFunctionを繰り返して使うときのため。

同じ隠し文字を繰り返し検索するようなとき、選択範囲を前方に潰してしまったらどういうことが起こるか、容易に想像がつくであろう!

使ってみる

次のコードで実験。

リスト3
Private Sub test03()
  Call SetCursorEndOfHiddenText("@2")
End Sub

これだけ。

バッチリ。

おわりに

見出しのところにうまい具合に隠し文字を設定すれば、任意の見出しの配下を簡単に取得することができるようになりますよ。

参考

 

akashi-keirin.hatenablog.com

akashi-keirin.hatenablog.com

隠し文字の表示/非表示の切り替え(Word)

隠し文字の表示/非表示の切り替え(Word)

隠し文字の表示/非表示を切り替える

超絶小ネタ。

文字通り、隠し文字の表示/非表示を手軽に切り替えるためのマクロ。

けっこうめんどくさいですからね。(ですよね? 知らんけど。)

では、さっそくコードをお目にかけよう!

リスト1
Public Sub ToggleShowHiddenText()
  With Application.ActiveWindow.View
    .ShowHiddenText = Not .ShowHiddenText
  End With
End Sub

たったこんだけ。

ViewオブジェクトのShowHiddenTextプロパティのオン/オフを切り替えているだけ。

使ってみる

では、動いているところをお目にかけよう。

なんてお手軽!

ショートカットキーでもあてがっておけば、超絶お手軽になるぜ!

おわりに

つくづく、Wordのマクロというやつは、こういう小ネタがお似合いだぜ……。

見出しの配下にある内容を取得する(Word)

見出しの配下にある内容を取得する(Word)

見出しの配下を取得したい

「見出し」というものは、普通、文書の〝意味のあるカタマリ〟ごとに付けるものだと思う。

「見出し」単位で、文書の内容を取り出せたら便利である。

ただ、〝手作業でコピッペする〟というのも、あまりスマートなやり方ではない。

定義済みブックマークを使う

そこで、「定義済みブックマーク」を使うのである!

コチラのページによると、「定義済みのブックマーク」には、「\HeadingLevel」というものがある。

挿入ポイントまたは選択範囲、および下位の見出しとテキストを含む見出し。 現在の選択範囲が本文テキストの場合、"\HeadingLevel" ブックマークには、前の見出しと、その見出しの下位にある見出しとテキストが含まれます。

自動翻訳なので、ちょいけったいな日本語になっている。

「挿入ポイント」とは、たぶん〝カーソル位置〟のことなのだろう。「挿入ポイントまたは選択範囲」というのは、要するにVBASelectionオブジェクトのことだと思う。(間違っていたら教えてください。)

つまり、たとえば、Selection.Bookmarks.Item("\HeadingLevel").Rangeとしてやれば、カーソル位置直前の見出し(見出しの中にカーソルがある場合は、その見出し)と、その配下にある見出し・本文をまるごと指し示すRangeオブジェクトが取得できるのである!

カーソルのある見出しの配下にある内容をクリップボードにコピーするマクロ

では、標題のマクロを作成してみよう。

リスト1
Private Sub copyHeadingLevel()
  Dim tgtRng As Range
  Set tgtRng = Selection.Bookmarks.Item("\HeadingLevel").Range
  Call tgtRng.Copy
End Sub

たったこれだけである!

使ってみる

まず、こんな文書を用意する。

「ナビゲーション」を見たらわかるように、見出しは2階層である。

「ナビゲーション」で見出しをクリックすると、カーソルはその見出しの先頭にジャンプする。

そこで、まず「開催・運営」という見出しをクリックする。

当然、「開催・運営」という見出しの先頭にカーソルが移動する。

この状態でリスト1を実行する。

見かけ上何も起きないが、この状態で、新しい文書にカーソルを置いて、

[Ctrl]+[ V ]をポチッ!

このように、見出し単位で貼り付けることができるのである!

ちなみに、

この状態(見出し「競輪用自転車」の配下には、さらに下位の見出し「部品全般」、「フレーム」、「ギア(ギヤ)」が設定されている。)で先ほどと同じことをすると、



こんなふうになる。

おわりに

Wordの「ブックマーク」機能は便利です。

もっと使いこなさないと!