1. 説明用サンプル プログラムの紹介

Private Sub CommandButton1_Click()
    Dim dataFilePath As String
    Dim dataBook As Workbook
    Dim i As Integer
    
    '① マクロ ブックのシート上のデータを取得
    dataFilePath = ThisWorkbook.Worksheets(1).Range("B1").Value
    
    '② データブックをオープン
    Set dataBook = OpenWorkBook(dataFilePath)
    If dataBook Is Nothing Then
        MsgBox "データ ブックが存在しないため処理中断"
        Exit Sub
    End If
    
    '③ データブックの A1 ～ A3 の値をマクロブックの A4 ～ A6 に転記
    For i = 1 To 3
        Call SetValue(dataBook, i)
    Next
    
    Call ChangeFormat '④ 書式設定を変更
    Call CloseBook(dataBook) '⑤ データ ブックを閉じる
    
    '⑥ 処理完了時にコントロールの Caption を変更
    CommandButton1.Caption = "転記済み"
    
    MsgBox "処理終了"
End Sub

Function OpenWorkBook(filePath As String) As Workbook
    Dim wb As Workbook
    If Dir(filePath) = "" Then
        Exit Function
    End If
    
    Set wb = Workbooks.Open(filePath)
    Set OpenWorkBook = wb
End Function

Sub SetValue(dataBook As Workbook, i As Integer)
    ThisWorkbook.Worksheets(1).Range("A" & 3 + i).Value = dataBook.Worksheets(1).Range("A" & i).Value
End Sub

Sub ChangeFormat()
    With ThisWorkbook.Worksheets(1).Range("A4:A6")
        .Font.ColorIndex = 3
        .Font.Bold = True
        .Borders.LineStyle = xlDouble
        .Borders.ColorIndex = 5
    End With
End Sub

Sub CloseBook(dataBook As Workbook)
    dataBook.Close
End Sub

2. デバッグ ログの追加 (関数単位)

Private Sub CommandButton1_Click()
LogWriteToBuffer "IN,Sheet1,CommandButton1_Click"
    Dim dataFilePath As String
    Dim dataBook As Workbook
    Dim i As Integer
    
    '① マクロ ブックのシート上のデータを取得
    dataFilePath = ThisWorkbook.Worksheets(1).Range("B1").Value
    
    '② データブックをオープン
    Set dataBook = OpenWorkBook(dataFilePath)
    If dataBook Is Nothing Then
        MsgBox "データ ブックが存在しないため処理中断"
LogWriteToBuffer "OUT,Sheet1,CommandButton1_Click"
        Exit Sub
    End If
    
    '③ データブックの A1 ～ A3 の値をマクロブックの A4 ～ A6 に転記
    For i = 1 To 3
        Call SetValue(dataBook, i)
    Next
    
    Call ChangeFormat '④ 書式設定を変更
    Call CloseBook(dataBook) '⑤ データ ブックを閉じる
    
    '⑥ 処理完了時にコントロールの Caption を変更
    CommandButton1.Caption = "転記済み"
    
    MsgBox "処理終了"
LogWriteToBuffer "OUT,Sheet1,CommandButton1_Click"

'★以下は手動で追加
LogWrite logOutputCollection
End Sub

Function OpenWorkBook(filePath As String) As Workbook
LogWriteToBuffer "IN,Sheet1,OpenWorkBook"
    Dim wb As Workbook
    If Dir(filePath) = "" Then
LogWriteToBuffer "OUT,Sheet1,OpenWorkBook"
        Exit Function
    End If
    
    Set wb = Workbooks.Open(filePath)
    Set OpenWorkBook = wb
LogWriteToBuffer "OUT,Sheet1,OpenWorkBook"
End Function

Sub SetValue(dataBook As Workbook, i As Integer)
LogWriteToBuffer "IN,Sheet1,SetValue"
    ThisWorkbook.Worksheets(1).Range("A" & 3 + i).Value = dataBook.Worksheets(1).Range("A" & i).Value
LogWriteToBuffer "OUT,Sheet1,SetValue"
End Sub

Sub ChangeFormat()
LogWriteToBuffer "IN,Sheet1,ChangeFormat"
    With ThisWorkbook.Worksheets(1).Range("A4:A6")
        .Font.ColorIndex = 3
        .Font.Bold = True
        .Borders.LineStyle = xlDouble
        .Borders.ColorIndex = 5
    End With
LogWriteToBuffer "OUT,Sheet1,ChangeFormat"
End Sub

Sub CloseBook(dataBook As Workbook)
LogWriteToBuffer "IN,Sheet1,CloseBook"
    dataBook.Close
LogWriteToBuffer "OUT,Sheet1,CloseBook"
End Sub

Public logOutputCollection As Collection
Public Sub LogWriteToBuffer(strMsg As String)
   If logOutputCollection Is Nothing Then
      Set logOutputCollection = New Collection
   End If
   logOutputCollection.Add getNowWithMS & "," & strMsg
End Sub

Public Sub LogWrite(logOutputCollection As Collection)
    Dim j As Integer
    Dim iFileNo As Integer
    iFileNo = FreeFile
    Open "C:\temp\VBAPerf.log" For Append As #iFileNo
    If Not logOutputCollection Is Nothing Then
        For j = 1 To logOutputCollection.Count
           Print #iFileNo, logOutputCollection(j)
        Next
    End If
    Close #iFileNo
End Sub

Function getNowWithMS() As String
   Dim dtmNowTime      ' 現在時刻
   Dim lngHour         ' 時
   Dim lngMinute       ' 分
   Dim lngSecond       ' 秒
   Dim lngMilliSecond  ' ミリ秒
   dtmNowTime = Timer
   lngMilliSecond = dtmNowTime - Fix(dtmNowTime)
   lngMilliSecond = Right("000" & Fix(lngMilliSecond * 1000), 3)
   dtmNowTime = Fix(dtmNowTime)
   lngSecond = Right("0" & dtmNowTime Mod 60, 2)
   dtmNowTime = dtmNowTime \ 60
   lngMinute = Right("0" & dtmNowTime Mod 60, 2)
   dtmNowTime = dtmNowTime \ 60
   lngHour = Right("0" & dtmNowTime, 2)
   getNowWithMS = lngHour & ":" & lngMinute & ":" & lngSecond & "." & lngMilliSecond
End Function

3. デバッグ ログの解析

19:08:08.562,IN,Sheet1,CommandButton1_Click
19:08:08.562,IN,Sheet1,OpenWorkBook
19:08:09.210,OUT,Sheet1,OpenWorkBook
19:08:09.210,IN,Sheet1,SetValue
19:08:10.230,OUT,Sheet1,SetValue
19:08:10.230,IN,Sheet1,SetValue
19:08:11.732,OUT,Sheet1,SetValue
19:08:12.733,IN,Sheet1,SetValue
19:08:14.221,OUT,Sheet1,SetValue
19:08:14.221,IN,Sheet1,ChangeFormat
19:08:23.123,OUT,Sheet1,ChangeFormat
19:08:23.125,IN,Sheet1,CloseBook
19:08:23.532,OUT,Sheet1,CloseBook
19:08:23.541,OUT,Sheet1,CommandButton1_Click

• 直前の処理との時間差 (「=A3-A2」ような数式で求められます) を算出し、特に時間がかかっている箇所を見つける
• 関数名のカウントを数え、繰り返し行われている処理を特定する

1. ChangeFormat 関数の IN ~ OUT の間が 1 回で 8.902 秒かかっている
2. SetValue 関数の IN ～ OUT の間が 3 回の合計で約 4 秒かかっている

4. デバッグ ログの追加 (行単位)

Sub ChangeFormat()
LogWriteToBuffer "IN,Sheet1,ChangeFormat"
    With ThisWorkbook.Worksheets(1).Range("A4:A6")
        .Font.ColorIndex = 3
LogWriteToBuffer "①,Sheet1,FontColorIndex"
        .Font.Bold = True
LogWriteToBuffer "②,Sheet1,FontBold"
        .Borders.LineStyle = xlDouble
LogWriteToBuffer "③,Sheet1,BorderLineStyle"
        .Borders.ColorIndex = 5
LogWriteToBuffer "④,Sheet1,BorderColorIndex"
    End With
LogWriteToBuffer "OUT,Sheet1,ChangeFormat"
End Sub

5. 関数単位の時刻ログ出力処理追加プログラム

• このサンプル コードの実行時、ログ出力処理を追加する対象のファイルを開く Office アプリケーションのオプション設定で、[セキュリティ センター] – [セキュリティ センターの設定] – [マクロの設定] – [VBA プロジェクト オブジェクト モデルへのアクセスを信頼する] を有効にする必要があります。(パフォーマンス計測時には有効にする必要はありません)
• VBAProject を参照・変更するため、VBAProject のパスワードは解除してください。
• ご利用の際は、AddToLogFunc() 内初めの 2 行の Const 定義をご自身の環境に合わせて変更してください。
• VBA 関数がどの順序で呼び出されるかは判断できないため、処理全体の最後に行うログのファイル出力処理呼び出しが含まれていません。手動で、処理全体の最後に「LogWrite logOutputCollection」 を追加してください。(2. のサンプルでは CommandButton1_Click() の最後に「'★以下は手動で追加」とコメントを入れている箇所です。)

1. 新規 Excel ブックの標準モジュールに以下のサンプル コードを貼り付けます。
2. AddToLogFunc() 内の Const 定義をご自身の環境に合わせて変更します。
3. AddToLogFunc() を実行します。ログ追加対象ファイルが開かれ、ログの追加が行われます。
4. "ログ出力処理追加完了 : 該当ファイルを別名で保存し、VBA の内容に問題がないか確認してください" と表示されたらVBE でログ追加対象ファイルのコードを開き、現象再現手順の処理全体の最後に「LogWrite logOutputCollection」を追記します。
5. ログ追加対象ファイルに別名を付けて保存します。
6. Excel をいったん閉じ、ログを追加したファイルを再度開いて再現手順を実行します。
7. 出力されたログファイル (手順 2. で設定したファイル パスに出力) を開き、ログを解析します。

'2018/7/12 公開版
'注 : このログ追加コードは、":" を用いて複数行を 1 行にまとめたコードには対応していません。

'Exit Sub / Exit Function へのログ出力処理追加
Function CheckExit(CurrentVBComponent As Object, strProcName As String, InProcCurrentLine As Long)

    Dim strCurrentCode As String
    Dim FoundPos As Long

    strCurrentCode = Trim(CurrentVBComponent.CodeModule.Lines(InProcCurrentLine, 1))

    'コメント行は除外
    If Left(strCurrentCode, 1) = "'" Or UCase(Left(strCurrentCode, 4)) = "REM " Then
        Exit Function
    End If

    'If xxx Then Exit Sub のような行の先頭以外に Exit がある書き方を考慮し InStr で合致確認
    FoundPos = InStr(strCurrentCode, "Exit ")
    
    '"Exit " に合致しても以下のケースは除外
    'a) Exit Sub の位置が先頭以外で、前にスペースがなく "xxxExit " のように文字列がある場合
    'b) 行の途中からコメントで、コメント部分に "Exit " がある場合
    'c) "Exit Sub" と "Exit Function" 以外の "Exit aaa" のような場合
    If FoundPos > 0 Then
        If (FoundPos > 1 And InStr(strCurrentCode, " Exit ") = 0) _
            Or (InStr(strCurrentCode, "'") > 0 And InStr(strCurrentCode, "'") < FoundPos) _
            Or (InStr(strCurrentCode, "Exit Sub") = 0 And InStr(strCurrentCode, "Exit Function") = 0) Then
            FoundPos = 0 'Exit Sub / Exit Function は見つからなかったものとみなす
        End If
    End If

    'Exit Sub / Exit Function のいずれかがある場合、その前に関数を抜けるログ出力処理追加
    If FoundPos > 0 Then
    
        'If xxx Then Exit Sub の書き方を考慮しコード整形
        If Left(strCurrentCode, 3) = "If " Then
        
            'いったん End If を入れる (If xxx Then Exit Sub + 改行 + End If)
            strCurrentCode = strCurrentCode & vbCrLf & "End If"
            
            '以下のように If 文を分割してコードを置き換え
            'Exit Sub の手前まで (If xxx Then )
            'ログ出力 (LogWriteToBuffer "OUT : " & CurrentVBComponent.Name & " : " & strProcName & "")
            'Exit Sub 以降 (Exit Sub + 改行 + End If)
            CurrentVBComponent.CodeModule.ReplaceLine InProcCurrentLine, _
                        Left(strCurrentCode, FoundPos - 1) & vbCrLf & _
                        "LogWriteToBuffer ""OUT," & CurrentVBComponent.Name & "," & strProcName & """" & vbCrLf & _
                        Mid(strCurrentCode, FoundPos)
        Else
            'その他通常の Exit の場合は直前に関数を抜けるログ追加
            CurrentVBComponent.CodeModule.InsertLines InProcCurrentLine, "LogWriteToBuffer ""OUT," & CurrentVBComponent.Name & "," & strProcName & """"
        End If
    End If
    
End Function


'メイン モジュール
Sub AddLogToFunc()
    
    '****************************************************
    'お客様環境に合わせて書き換えてください
    Const szBookFile = "C:\work\testProgram.xlsm" 'ログ出力処理を追加するファイルのフルパス
    Const szLogFile = "C:\work\VBAPerf.log" 'ログ出力ファイルのフルパス
    '****************************************************
    
    Const vbext_ct_StdModule = 1 'VBComponent Type 定数 : 標準モジュール
    Const vbext_pk_Proc = 0 'prockind 定数 : プロパティ プロシージャ以外のすべてのプロシージャ
    
    Dim xlBook As Workbook
    Dim CurrentVBComponent As Object 'VBComponent
    Dim TotalLine As Long
    Dim CurrentLine As Long
    Dim strProcName As String
    Dim strCurrentCode As String
    Dim ProcStartLine As Long
    Dim ProcEndLine As Long
    Dim InProcCurrentLine As Long
    Dim FoundPos As Long
    Dim strFunc As String
    
    Application.EnableEvents = False
    
    Set xlBook = Workbooks.Open(szBookFile) 'ログ出力処理追加対象ブック オープン

    ' 対象ブックに含まれる各モジュール内関数の最初と最後にログ出力関数呼び出しを追加
    For Each CurrentVBComponent In xlBook.VBProject.VBComponents
    
        TotalLine = CurrentVBComponent.CodeModule.CountOfLines
        
        'コード末尾から 1 行ごとに確認
        For CurrentLine = TotalLine To 1 Step -1
        
            strProcName = CurrentVBComponent.CodeModule.ProcOfLine(CurrentLine, vbext_pk_Proc) 'その行が属するプロシージャ名を取得
            strCurrentCode = LTrim(CurrentVBComponent.CodeModule.Lines(CurrentLine, 1))
            
            'End で始まる場合 : そのプロシージャの初めと終わりに処理追加
            If strProcName <> Empty And Left(strCurrentCode, 4) = "End " Then
            
                ProcStartLine = CurrentVBComponent.CodeModule.ProcBodyLine(strProcName, vbext_pk_Proc) + 1 'プロシージャの先頭行を取得
                ProcEndLine = CurrentLine
                
                'End 行の前に関数を抜けるログ出力処理追加
                CurrentVBComponent.CodeModule.InsertLines ProcEndLine, "LogWriteToBuffer ""OUT," & CurrentVBComponent.Name & "," & strProcName & """"
                'プロシージャ開始行の直後に関数に入るログ出力処理追加
                CurrentVBComponent.CodeModule.InsertLines ProcStartLine, "LogWriteToBuffer ""IN," & CurrentVBComponent.Name & "," & strProcName & """"
                
                'さらにこのプロシージャ内の途中で処理追加すべき箇所 (Exit Sub / Exit Function) をチェック
                '(OUT ログ追加により CurrentLine は End Sub の 1 行前を指す)
                For InProcCurrentLine = CurrentLine To ProcStartLine Step -1
                    CheckExit CurrentVBComponent, strProcName, InProcCurrentLine
                Next
                
                'このプロシージャの処理は終わっているためプロシージャ先頭までスキップ
                CurrentLine = ProcStartLine - 1
                
            End If
        Next
    Next

    '*************************************************************************
    'サブ関数追加処理
    '*************************************************************************
    
    ' ファイル出力時のディスク アクセスによるパフォーマンス影響を抑えるため、
    ' 処理実行中のログはいったん配列に書き込み、最後にファイル出力する

    'ログを配列に格納するための関数
    strFunc = "" & vbCrLf & _
              "Public logOutputCollection As Collection" & vbCrLf & _
              "Public Sub LogWriteToBuffer(strMsg As String)" & vbCrLf & _
              "   If logOutputCollection Is Nothing Then" & vbCrLf & _
              "      Set logOutputCollection = New Collection" & vbCrLf & _
              "   End If" & vbCrLf & _
              "   logOutputCollection.Add getNowWithMS & "","" & strMsg" & vbCrLf & _
              "End Sub"

    '配列からログファイルへの出力のための関数
    strFunc = strFunc & vbCrLf & _
              "" & vbCrLf & _
              "Public Sub LogWrite(logOutputCollection As Collection)" & vbCrLf & _
              "    Dim j As Integer" & vbCrLf & _
              "    Dim iFileNo As Integer" & vbCrLf & _
              "    iFileNo = FreeFile" & vbCrLf & _
              "    Open ""[LOG_FILE]"" For Append As #iFileNo" & vbCrLf & _
              "    If Not logOutputCollection Is Nothing Then" & vbCrLf & _
              "        For j = 1 To logOutputCollection.Count" & vbCrLf & _
              "           Print #iFileNo,  logOutputCollection(j)" & vbCrLf & _
              "        Next" & vbCrLf & _
              "    End If" & vbCrLf & _
              "    Close #iFileNo" & vbCrLf & _
              "End Sub"


    '現在時刻取得関数
    strFunc = strFunc & vbCrLf & _
              "" & vbCrLf & _
              "Function getNowWithMS() As String" & vbCrLf & _
              "   Dim dtmNowTime      ' 現在時刻" & vbCrLf & _
              "   Dim lngHour         ' 時" & vbCrLf & _
              "   Dim lngMinute       ' 分" & vbCrLf & _
              "   Dim lngSecond       ' 秒" & vbCrLf & _
              "   Dim lngMilliSecond  ' ミリ秒" & vbCrLf & _
              "   dtmNowTime = Timer" & vbCrLf & _
              "   lngMilliSecond = dtmNowTime - Fix(dtmNowTime)" & vbCrLf & _
              "   lngMilliSecond = Right(""000"" & Fix(lngMilliSecond * 1000), 3)" & vbCrLf & _
              "   dtmNowTime = Fix(dtmNowTime)" & vbCrLf & _
              "   lngSecond = Right(""0"" & dtmNowTime Mod 60, 2)" & vbCrLf & _
              "   dtmNowTime = dtmNowTime \ 60" & vbCrLf & _
              "   lngMinute = Right(""0"" & dtmNowTime Mod 60, 2)" & vbCrLf & _
              "   dtmNowTime = dtmNowTime \ 60" & vbCrLf & _
              "   lngHour = Right(""0"" & dtmNowTime, 2)" & vbCrLf & _
              "   getNowWithMS = lngHour & "":"" & lngMinute & "":"" & lngSecond & ""."" & lngMilliSecond" & vbCrLf & _
              "End Function"


    strFunc = Replace(strFunc, "[LOG_FILE]", szLogFile) '冒頭で設定したログファイル パスに書き換え
    xlBook.VBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule.AddFromString strFunc '新しい標準モジュールを作成し関数を追記

    Application.EnableEvents = True
    
    MsgBox "ログ出力処理追加完了 : 該当ファイルを別名で保存し、VBA の内容に問題がないか確認してください"
    
End Sub

3-1. ボトルネックとなる処理の速度改善 3-2. プログラム構成の見直し 3-3. プログラム全体のパフォーマンス チューニング 3-4. 他の言語から VBA に変更する 3-5. マシン リソースの増強

1. はじめに : Office におけるパフォーマンス

2. プログラム上のボトルネックの特定

3. 対処方法の検討

3-1. ボトルネックとなる処理の速度改善

3-2. プログラム構成の見直し

3-3. プログラム全体のパフォーマンス チューニング

3-4. 他の言語から VBA に変更する

• Office では、プログラム処理の最後に画面描画やデータの同期等、処理に伴う結果を Office 全体に反映させるクリーンナップ処理を行います。VBA で実装した場合は、Office は「一連の処理」がどこからどこまでか範囲を認識可能なため、処理全体が完了したときにクリーンナップ処理を行います。一方、他の言語を用いてオートメーションされる場合は、「一連の処理」の範囲を認識できません。このため、1 つ 1 つの処理呼び出し (メソッド呼び出し 1 回、プロパティ変更 1 回、など) ごとにクリーンナップ処理を行います。このため、他の言語では VBA と比較して非常に多くのクリーンナップ処理が呼び出され、その分のパフォーマンス コストがかかります。

• 他の言語から Office の COM オブジェクトへの処理呼び出しに伴い、マーシャリングが行われます。僅かなコストではありますが、各処理においてマーシャリングが行われることの積み重ねでパフォーマンスに影響を与えます。VBA の場合は、内部呼び出しのためこのコストはかかりません。(特に .NET プログラムからの呼び出しの場合は、ランタイム呼び出し可能ラッパー (RCW) によるマーシャリングが行われ、アンマネージド コードと比較するとさらに低速となります。)

参考)

タイトル : ランタイム呼び出し可能ラッパー アドレス : https://docs.microsoft.com/ja-jp/dotnet/framework/interop/runtime-callable-wrapper

• .NET プログラムの場合は、以下の資料で説明するように適切なタイミングで COM オブジェクトの解放が必要です。ガベージ コレクトはパフォーマンス コストの高い処理のため、これを適宜呼び出すことによって、(適切な実装が行われた) .NET プログラムではプログラム全体としてパフォーマンスが低下します。

タイトル : Office オートメーションで割り当てたオブジェクトを解放する – Part1 アドレス : https://blogs.msdn.microsoft.com/office_client_development_support_blog/2012/02/09/office-5/

タイトル : Office オートメーションで割り当てたオブジェクトを解放する – Part2 アドレス : https://blogs.msdn.microsoft.com/office_client_development_support_blog/2012/02/28/office-3/

3-5. マシン リソースの増強

1. メール タイトルや本文などが UTF-8 で送信される
2. 差し込み印刷でタイトルは ANSI(SJIS) / 本文は UTF-8 で送信される

1. Word 2016 でのテキストメールの UTF-8 への変更

• 既定のメール アプリケーションを Outlook 2016 に変更する
• メール アプリケーションの設定でメール受信時の文字コードを設定可能な場合は、UTF-8 に設定する
• メール アプリケーションでメールを作成後、Word で作成した文書を添付、または内容をコピー＆貼り付けする

2. 差し込み印刷でタイトルのみ文字化けする

• Outlook を使用している場合は、HTML 形式でメールを送信する (MAPI とは別の仕組みで送信されるため、この問題が生じる処理を行いません)
• メール アプリケーションでメールを作成後、Word で作成した文書を添付、または内容をコピー＆貼り付けする
• クイック実行版の Office 2016 (最新バージョン) を利用する

1. Microsoft ストア版 Office 2016 とは？

1-1. クイック実行 (C2R) 形式

1-2. MSI インストーラ形式

1-3. Microsoft ストア版 Office 2016 (Centennial 版)

2. Microsoft ストア版 Office 2016 の DLL 読み込み動作

Private Declare Sub MyFunc Lib "TEST.dll" () 
Sub Sample()
    MyFunc
End Sub

3. 対応方法

3-1. プログラムで検索パスを指定する

3-2. C2R 版 Office に変更する

再現手順

Private Sub CommandButton1_Click()
    UserForm1.WebBrowser1.Navigate2 ("http://www.microsoft.com")
End Sub

現象詳細

• 「ディスプレイで最適な解像度を使用」機能は、Excel / Word / PowerPoint / Visio に追加されていますが、Word では本手順で現象は発生しません。
• OS が Windows 10 バージョン 1703 より古い場合は、「ディスプレイで最適な解像度を使用」オプションは表示されません。
• VBE のメニューの実行ボタン (緑色の右三角のボタン) や、[実行] – [Sub/ユーザーフォームの実行] から実行すると、現象は発生しません。F5 キーや、プロシージャから UserForm.Show を実行してユーザーフォームを表示する場合に発生します。

回避策

1. 現象の詳細

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

• マクロがブック オープンと同時に自動実行される場合にのみ発生します。セキュリティの警告の黄色いバーが表示されて一旦マクロが無効化され、[コンテンツの有効化] でマクロを実行する場合は問題ありません。
• ブック オープン時に動作する Workbook_Open イベント ハンドラ、Application.WorkbookOpen イベント ハンドラ、Auto_Open メソッドのいずれも現象が発生します。
• ユーザーフォームを閉じる操作は、×ボタン、Unload メソッド、Hide メソッドのいずれも現象が発生します。
• ユーザーフォームがモーダル表示の場合にのみ現象が発生します。モードレス表示の場合は問題ありません。
• Excel アドイン (.xlam / .xla) をアドインとして登録して同様の処理を行う場合は問題ありません。

2. マクロの自動実行に関する設定

•  [すべてのマクロを有効にする] に設定されている場合
• [デジタル署名されたマクロを除き、全てのマクロを無効にする] に設定されており、かつマクロに信頼された証明書でデジタル署名が行われている場合
• [警告を表示してすべてのマクロを無効にする] または [警告を表示せずにすべてのマクロを無効にする] に設定されており、ドキュメントが信頼できる状態である場合

マクロのセキュリティ設定が [警告を表示してすべてのマクロを無効にする] の場合に、1 度そのブックを開いてマクロを有効にすると、そのブックは信頼できるドキュメントに登録され、次回以降マクロが自動的に有効化されます。

ここに登録されたフォルダに格納されたブックは信頼され、マクロが自動的に実行されます。

ここに表示されている証明書 (ユーザーの証明書ストア [信頼された発行元] に登録された証明書) でマクロにコード署名が行われているブックは信頼され、マクロが自動的に実行されます。

3. 対応方法

4. 暫定回避方法

4-1. Office 2016 の自動更新を停止し、バージョンを 1711 以前のままで利用する

4-2. マクロが自動実行されず警告が表示されるようにする

• オプションの [セキュリティ センター] - [セキュリティ センターの設定] - [マクロの設定] を [警告を表示してすべてのマクロを無効にする] に設定 (既定)
• オプションの [セキュリティ センター] - [セキュリティ センターの設定] - [信頼済みドキュメント] の [信頼済みドキュメントを無効にする] のチェックを入れる

4-3. ユーザーフォームをモードレス表示にする

UserForm1.Show vbModeless

4-4. Application.OnTime メソッドでユーザーフォームを表示する

Application.OnTime Now + TimeValue("00:00:01"), "Sample"

Private Sub Workbook_Open()
    Application.OnTime Now + TimeValue("00:00:01"), "Sample"
End Sub

Public Sub Sample()
    UserForm1.Show
End Sub

1. BackStage ビューのカスタマイズ

• 既存メニューを非表示にする
• 左側のメニューに独自メニューを追加する
• メニュー内の項目に独自のメニューを追加する

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
	<ribbon startFromScratch="true"/>
	<backstage>
		<tab idMso="TabInfo" visible="false"/>
		<tab idMso="TabOfficeStart" visible="false"/>
		<tab idMso="TabRecent" visible="false"/>
		<button idMso="FileSave" visible="false"/>
		<tab idMso="TabSave" visible="false"/>
		<tab idMso="TabPrint" visible="false"/>
		<tab idMso="TabShare" visible="false"/>
		<tab idMso="TabPublish" visible="false"/>
		<tab idMso="Publish2Tab" visible="false"/>
		<button idMso="FileClose" visible="false"/>
		<tab idMso="TabHelp" visible="false"/>
		<tab idMso="TabOfficeFeedback" visible="false"/>
		<button idMso="ApplicationOptionsDialog" visible="false"/>
	</backstage>
</customUI>

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
       <backstage onShow="onShowMethod" onHide="onHideMethod" />
</customUI>

Sub onShowMethod(contextObject As Object)
    MsgBox "BackStage メニューに遷移しました"
End Sub

Sub onHideMethod(contextObject As Object)
    MsgBox "BackStage メニューを閉じてブックに遷移しました"
End Sub

2. 右クリック メニューのカスタマイズ

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
       <contextMenus>
              <contextMenu idMso="ContextMenuShape">
                     <control idMso="Cut" visible="false"/>
                     <control idMso="Copy" visible="false"/>
                     <control idMso="PasteGalleryMini" visible="false"/>
                     <control idMso="ObjectEditText" visible="false"/>
                     <control idMso="ObjectEditPoints" visible="false"/>
                     <control idMso="ObjectsGroupMenu" visible="false"/>
                     <control idMso="ObjectBringToFrontMenu" visible="false"/>
                     <control idMso="ObjectSendToBackMenu" visible="false"/>
                     <control idMso="InsertLinkGallery" visible="false"/>
                     <control idMso="Insights" visible="false"/>
                     <control idMso="MacroAssign" visible="false"/>
                     <control idMso="ObjectSetShapeDefaults" visible="false"/>
                     <control idMso="ObjectSizeAndPropertiesDialog" visible="false"/>
                     <control idMso="ObjectFormatDialog" visible="false"/>
              </contextMenu>
       </contextMenus>
</customUI>

3. クイック アクセス ツールバーのカスタマイズ

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
       <ribbon startFromScratch="true">
              <qat>
                     <documentControls>
                            <control idMso="FileSave" />
                            <button id="Mymenu" label="Mymenu" image="MymenuIcon" onAction="MymenuCallback"/>
                     </documentControls>
              </qat>
       </ribbon>
</customUI>

1. ユーザー定義関数の作成

Public Function TestUDF(num As Integer, str As String) As String
    TestUDF = "No." & num & "は" & str & "です"
End Function

2. 関数の情報を登録する

Sub RegisterTestUDF()
    Application.MacroOptions Macro:="TestUDF", Description:="引数 1 と 2 を組み合わせて文章を作成する関数です。", _
    Category:="文字列操作", ArgumentDescriptions:=Array("引数 1 : 整数", "引数 2 : 文字列"), _
    HelpFile:="http://www.microsoft.com/help/helpPage.html"
End Sub

3. ヘルプ情報を登録する

関連情報

タイトル : カスタム ヘルプ トピックの作成

アドレス : https://msdn.microsoft.com/ja-jp/library/cc389851.aspx

タイトル : Microsoft HTML Help Downloads

アドレス : https://msdn.microsoft.com/en-us/library/windows/desktop/ms669985(v=vs.85).aspx

タイトル : HTML Help Workshop and Documentation

アドレス : https://www.microsoft.com/en-us/download/details.aspx?id=21138

.hlp ファイルを開くのに必要な更新プログラム

文書番号 : 917607

タイトル : Windows ベースのプログラムでヘルプを開こうとすると、「機能は含まれていません」または「ヘルプはサポートされていません」とエラーが表示されます

アドレス : https://support.microsoft.com/ja-jp/help/917607

参考資料

タイトル : ヘルプ ファイル (WinHelp)

アドレス : https://msdn.microsoft.com/ja-jp/library/ew744dk7.aspx

1. .xls 形式のファイルのリボン カスタマイズを行う (アドインからファイルごとにリボンをカスタマイズする)

• .xlam 形式の Excel アドインを用意する
• VSTO アドインを用意する
• VSTO で Excel ブック (.xls) 形式のカスタマイズを作成する

Public Sub GetEnabledMacro(control As IRibbonControl, ByRef Enabled)
    If control.ID = "B1_Button1" Then
        If ActiveWorkbook.Name = "Book1.xls" Then
            Enabled = True
        Else
            Enabled = False
        End If
    ElseIf control.ID = "B2_Button1" Then
        If ActiveWorkbook.Name = "Book2.xls" Then
            Enabled = True
        Else
            Enabled = False
        End If
    End If
End Sub

'以下はボタンクリック時に実行されるマクロ
Public Sub B1_Button1_Callback(control As IRibbonControl)
    MsgBox "Book1 用のボタンをクリックしました"
End Sub

Public Sub B2_Button1_Callback(control As IRibbonControl)
    MsgBox "Book2 用のボタンをクリックしました"
End Sub

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
    <ribbon>
        <tabs>
            <tab id="customTab" label="Custom Tab">
                <group id="CustomGroup" label="Custom Menu">
                    <button id="B1_Button1" label="Book1 button" imageMso="HappyFace" size="large" getEnabled="GetEnabledMacro" onAction="B1_Button1_Callback" />
                    <button id="B2_Button1" label="Book2 button" imageMso="HappyFace" size="large" getEnabled="GetEnabledMacro" onAction="B2_Button1_Callback" />
                </group>
            </tab>
        </tabs>
    </ribbon>
</customUI>

2. 任意のタイミングでリボンの状態を変更する

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui" onLoad="ribbonLoaded">
    <ribbon>
        ・・・
    </ribbon>
</customUI>

'XML の onLoad 定義から呼び出されるマクロ
Public Sub ribbonLoaded(ribbon As IRibbonUI)
    Set myRibbon = ribbon
End Sub

myRibbon.Invalidate