VBA・マクロツール

【知らなくても使える】Excelのシート毎に分けてPDF出力するアドイン_パート2(Excel VBA)

Excelで作成したデータをPDFファイルで保存または出力する際に、シート毎で複数のPDFファイルで保存したいと思った際に、Excelの標準機能では現状実現することができないかと思います。

 

以前、一つのPDFファイルに保存する場合複数のPDFファイルに分けて保存する場合の2種類を使い分けることができるツール『Excelのシート毎に分けてPDF出力するツール』をExcel VBAのアドインで作成しましたが、それのパート2になります。

 

ちなみにパート1は以下になります。

【知らなくても使える】Excelのシート毎に分けてPDF出力するアドイン(Excel VBA) Excelで作成したデータをPDFファイルで保存または出力する際に、シート毎で複数のPDFファイルで保存したいと思った際に、Ex...

 

変更した箇所は以下になります。

  1. ファイル名に値を追加する場所を「最初」と「最後」で選択できるようになりました。
  2. 追加する値を固定の値だけでなく、各シートのセル内の値から取得できるようになりました。

 

当記事にはマクロの元になるExcelファイルがダウンロード可能で、VBAのコードも記事内に記載がありますので、Excel VBAやマクロが良く分からないという方でもすぐに使用できます

当ツールを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。

 

『Excelのシート毎に分けてPDF出力するツール(パート2)』の概要

ExcelにVBAコードを入れてマクロを作成し、アドインとして保存します。

 

そのアドインを取り込むとリボンに一つのPDFで保存するパターンと複数のPDFで保存するパターンとでタブが表示されるので、それぞれ該当するボタンを押すことでPDFファイルの出力方法を使い分けることができます

当ツールの使用方法

基本的な機能、操作方法の説明

  1. PDF出力したいExcelファイルを開きます。
  2. 「開発」タブの「Excelアドイン」より、作成したアドインファイルを指定(参照)します。

 

※選択するExcelアドインは、当ぺージ内のツールをダウンロードしてVBAコードを貼り付けて保存したアドインファイルを選択してください。

 

アドインを設定出来たら、上部リボンのタブに「保存」が追加されます。

 

 

❶:1つのPDFで保存(全シートを対象)

<手順1>

  1. リボン「保存」→「1つのPDFで保存」内にある「全シートを対象」クリックします。

 

<手順2>

  1. 保存先を選択してファイル名を入力します。
  2. 「保存」をクリックします。

※デフォルトのファイル名は「Excelファイル名称」+「.pdf」となっています

全シート分のExcelデータが一つのPDFファイルとして保存されます。

 

❷:1つのPDFで保存(指定したシートのみを対象)

<手順1>

  1. リボン「保存」→「1つのPDFで保存」内にあるシート名を入力して、「指定シートを対象」をクリックします。

 

<手順2>

  1. 保存先を選択し、ファイル名を入力して「保存」をクリックします。

※デフォルトのファイル名は「Excelファイル名称」+「.pdf」となっています

リボン内の指定シートを対象の「シート名」に入力したシートを対象にしてExcelデータが一つのPDFファイルとして保存されました。

 

なお、シート名にはワイルドカード(*、?など)を指定可能です。

 

❸:複数のPDFファイルで保存

<手順1>

  1. リボン「保存」→「複数のPDFで保存」内の「全シートを対象」をクリックします。

 

<手順2>

  1. 保存先のフォルダを選択して「OK」をクリックします。

※複数PDFファイルが作成されるため、保存先のフォルダを選択します

なお、複数のPDFで保存する場合でも対象のシートを指定することができます。

 

<Option>

ファイル名に追加する値等の選択

ファイル名に任意の値を追加することができます。選択できることは以下の3つになります。

  1. なし
  2. 値を指定
  3. 特定のセルから取得

詳細はそれぞれ以下になります。

追加位置

ファイル名への値の追加位置を以下から指定できます。

  1. 最初
  2. 最後

詳細はそれぞれ以下になります。

 

例として以下の条件で実行した場合

  • ファイル名に追加より「値を指定」を選択
  • 追加する値に『令和4年度_』を入力
  • 追加位置で「最初」を選択
  • 複数のPDFで保存より『指定したシートを対象』をクリックする

 

実行後は以下のファイルが作成されます。

リボン内で指定した『「追加する値」で指定した値+「シート名」』のファイル名で複数のPDFファイルが保存されました。

 

なお、リボンに表示されている文字等のデザインを変更する場合は、【解説】リボンに表示されたExcelアドインのデザインを変更する方法を参照ください。

 

留意事項

シート名はワイルドカードが使用可能

一つのPDFで保存する時に、指定シートを対象にしてPDF出力する場合は、シート名の指定で以下のワイルドカード( * や ? など)を指定できます。

  •  * :任意の数の文字と一致します。 文字列のどの場所でも使用できます。
  •  ? :指定した場所の任意の 1 文字と一致します。
  •  [ ] 角かっこ内の 1 文字と一致します。
  •  ! :角かっこ内の文字以外と一致します。
  •  - :範囲内の任意の文字と一致します。 (この範囲は昇順で指定)
  •  # :任意の 1 つの数字と一致します。

例)

  • 「R4*」→R4から始まるシートが対象 / 「*10月」→最後に10月がつくシートが対象
  • 「Sheet?」 →Sheet1、Sheet2が対象(Sheet10は対象外)
  • 「b[ae]ll」→ball と bell が対象(bill は対象外)
  • 「b[!ae]ll」→bill と bull は対象(ball や bell は対象外)
  • 「b[a-c]d」→bad、bbd、bcd が対象
  • 「1#3」→103、113、123 が対象

= 引用元:Microsoftサポート(ワイルドカード文字の例) =

 

使用する際の事前準備

このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。

 

以下にその手順を説明していきます。

 

準備の手順

1.サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードし、ファイルを開きます。

※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

 

2.ダウンロードしたExcelファイルの上部にあるリボンの「開発」タブから「visual basic」を選択して、VBE(Visual Basic Editor)を起動させます。

 

リボンに「開発」タブが表示されていない場合は、以下を参照ください。

(参考サイト:記事「Excel VBAを始める前に、最初にやっておくべき初期設定内容はこれ」の『開発』タブを表示させる

 

3.「プロジェクト」に「標準モジュール」を追加して、追加された「Module1」にVBAコードを記載します。

 

以下にあるVBAコードを「Module1」内のエディターにコピーして貼り付けます。

 

VBAのソースコードはこちら

以下のVBAコードをコピーして、「Module1」内のエディターに貼り付けます。

※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます

Option Explicit

'-----(設定値)------------------------
Private Const ADD_NOTHING = "0"                 '1.ファイル名に追加:「なし」
Private Const ADD_VALUE = "1"                   '2.ファイル名に追加:「値を指定」
Private Const ADD_CELL_POINT = "2"              '3.ファイル名に追加:「特定のセルから取得」
Private Const SET_FIRST = "1"                   '4.追加位置:「最初」
Private Const SET_LAST = "2"                    '5.追加位置:「最後」
Private Const SET_VALUE_WORD = " 追加する値:"   '6.追加する種別のラベル:追加する値
Private Const SET_VALUE_CELL = " セル位置:"     '7.追加する種別のラベル:セル位置
'---------------------------------------

'-----(メッセージ)-------------------
Private Const Msg1 = "PDfファイルを保存するフォルダを選択してください。"
Private Const Msg2 = "指定したシートが存在しません。"
Private Const Msg3 = "指定したファイル名称が正しくありません。" & vbLf & "正しいファイル名称を設定してください。"
Private Const Msg4 = "「セル位置」は有効なアドレスを入力して下さい。"
'---------------------------------------

Dim RbRibbon As IRibbonUI               'リボン
Dim TgtSheetNm As String                '保存対象のシート名
Dim TgtAddFileNm As String              'ファイル名に追加する値
Dim TgtAddCellPosition As String        'ファイル名に追加する値が入っているセルの位置
Dim LblInsertInfo As String             '「追加する値」または「セル位置」のラベル
Dim SetPlace As String                  '貼り付け位置
Dim SetValue As String                  '貼り付けする値
Dim SelInsertInfo As String             '「ファイル名に追加」で選択した値(1:値を指定 2:特定のセルから取得)

'===================================
'リボンの初期処理
'===================================
Sub pdf_export_onLoad(ribbon As IRibbonUI)
    
    'リボンの表示を更新できるようにするためにリボンをセットする
    Set RbRibbon = ribbon
    RbRibbon.Invalidate
    SetValue = ADD_NOTHING
    SetPlace = SET_FIRST
    
End Sub

'===================================
'ファイル名に追加する情報の「追加する値」または「セル位置」のラベル設定
'===================================
Public Sub edb_AdditionalInfo_getLabel(control As IRibbonControl, ByRef returnedVal)
    
    If SetValue = ADD_VALUE Then
        returnedVal = SET_VALUE_WORD        '追加する値:という文言に設定する
    ElseIf SetValue = ADD_CELL_POINT Then
        returnedVal = SET_VALUE_CELL        'セル位置:という文言に設定する
    Else
        If LblInsertInfo <> "" Then
            returnedVal = LblInsertInfo     '直前の文言を設定する
        Else
            returnedVal = SET_VALUE_WORD    '追加する値:という文言に設定する
        End If
    End If
    
End Sub

'===================================
'シート名に変更があった際の処理
'===================================
Public Sub edb_sheetNm_onChange(control As IRibbonControl, Text As String)
    TgtSheetNm = Text
End Sub

'===================================
'「ファイル名に追加」で「なし」が押された際の処理
'===================================
Public Sub tgl_nothing_getPressed(control As IRibbonControl, ByRef returnedVal)
    returnedVal = getPress_InsertInfo(control)
End Sub

'===================================
'「ファイル名に追加」で「なし」を選択した際の処理
'===================================
Public Sub tgl_nothing_onAction(control As IRibbonControl, ByRef cancelDefault)
    Call change_additionalInfo(control)
End Sub

'===================================
'「ファイル名に追加」で「値を取得」が押された際の処理
'===================================
Public Sub tgl_tgtValue_getPressed(control As IRibbonControl, ByRef returnedVal)
    returnedVal = getPress_InsertInfo(control)
End Sub

'===================================
'「ファイル名に追加」で「値を取得」を選択した際の処理
'===================================
Public Sub tgl_tgtValue_onAction(control As IRibbonControl, ByRef cancelDefault)
    Call change_additionalInfo(control)
End Sub

'===================================
'「ファイル名に追加」で「特定のセルから取得」が押された際の処理
'===================================
Public Sub tgl_tgtCell_getPressed(control As IRibbonControl, ByRef returnedVal)
    returnedVal = getPress_InsertInfo(control)
End Sub
    
'===================================
'「ファイル名に追加」で「特定のセルから取得」を選択した際の処理
'===================================
Public Sub tgl_tgtCell_onAction(control As IRibbonControl, ByRef cancelDefault)
    Call change_additionalInfo(control)
End Sub

'===================================
'ファイル名に追加する値をどこから取得するか選択した際の活性/非活性の処理
'===================================
Public Sub edb_AdditionalInfo_getEnabled(control As IRibbonControl, ByRef returnedVal)

    If SetValue = ADD_NOTHING Then
        returnedVal = False
    Else
        returnedVal = True
    End If
    
End Sub

'===================================
'ファイル名に追加する値をどこから取得するかの値を取得する処理
'===================================
Public Sub edb_AdditionalInfo_getText(control As IRibbonControl, ByRef returnedVal)
    returnedVal = ""
End Sub

'===================================
'ファイル名に追加する値をどこから取得するかを変更した際の処理
'===================================
Public Sub edb_AdditionalInfo_onChange(control As IRibbonControl, Text As String)
    
    If SetValue = ADD_NOTHING Then
        TgtAddFileNm = ""
        TgtAddCellPosition = ""
    ElseIf SetValue = ADD_VALUE Then
        TgtAddFileNm = Text
        TgtAddCellPosition = ""
    ElseIf SetValue = ADD_CELL_POINT Then
        TgtAddFileNm = ""
        
        'セルのアドレスを指定しているかチェックする
        If Evaluate("ISREF(" & Text & ")") Then
            TgtAddCellPosition = Text
        Else
            TgtAddCellPosition = ""
            Text = ""
            MsgBox Msg4
            RbRibbon.InvalidateControl ("edb_AdditionalInfo")
        End If
        
    End If

End Sub

'===================================
'追加位置の活性/非活性の処理
'===================================
Public Sub lgl_addPoint_getEnabled(control As IRibbonControl, ByRef returnedVal)
    If SetValue = ADD_NOTHING Then
        returnedVal = False
    Else
        returnedVal = True
    End If
    
End Sub

'===================================
'ファイルの追加位置で「最初」アイコンが押された際の処理
'===================================
Public Sub tgl_first_getPressed(control As IRibbonControl, ByRef returnedVal)
    returnedVal = getPress_InsertPoint(control)
End Sub

'===================================
'ファイルの追加位置で「最初」アイコンが押された際の活性/非活性の処理
'===================================
Public Sub tgl_first_getEnabled(control As IRibbonControl, ByRef returnedVal)
    If SetValue = ADD_NOTHING Then
        returnedVal = False
    Else
        returnedVal = True
    End If
    
End Sub

'===================================
'ファイルの追加位置で「最初」アイコンを選択した際の処理
'===================================
Public Sub tgl_first_onAction(control As IRibbonControl, ByRef cancelDefault)
    Call change_InsertPoint(control)
End Sub

'===================================
'ファイルの追加位置で「最後」アイコンが押された際の処理
'===================================
Public Sub tgl_last_getPressed(control As IRibbonControl, ByRef returnedVal)
    returnedVal = getPress_InsertPoint(control)
End Sub

'===================================
'ファイルの追加位置で「最後」アイコンが押された際の活性/非活性の処理
'===================================
Public Sub tgl_last_getEnabled(control As IRibbonControl, ByRef returnedVal)
    If SetValue = ADD_NOTHING Then
        returnedVal = False
    Else
        returnedVal = True
    End If
    
End Sub

'===================================
'ファイルの追加位置で「最後」アイコンを選択した際の処理
'===================================
Public Sub tgl_last_onAction(control As IRibbonControl, ByRef cancelDefault)
    Call change_InsertPoint(control)
End Sub


'===================================
'全シートを対象にして一つのPDFに保存した際の処理
'===================================
Public Sub allSheetForOnePDF_onAction(control As IRibbonControl)

    Dim sheetCnt As Long: sheetCnt = ActiveWorkbook.Worksheets.Count
    Dim sheetNmArray() As String        'Excelブック内のシート名称(配列)
    ReDim sheetNmArray(1 To sheetCnt)
    Dim visShtCnt As Long               '表示中のシート数
    Dim i As Long
    
    '全てのシートを対象にするため配列に全シート名を格納する
    For i = 1 To sheetCnt
        If ActiveWorkbook.Sheets(i).Visible = True Then
            visShtCnt = visShtCnt + 1
            sheetNmArray(visShtCnt) = ActiveWorkbook.Sheets(i).Name
        End If
    Next i
    
    ReDim Preserve sheetNmArray(1 To visShtCnt)
    
    ''PDFファイル保存処理
    Call savePdf(sheetNmArray, 1)
    
End Sub

'===================================
'指定したシートを対象にして1つのPDFに保存した際の処理
'===================================
Public Sub tgtSheetForOnePDF_onAction(control As IRibbonControl)

    Dim sheetCnt As Long: sheetCnt = ActiveWorkbook.Worksheets.Count
    Dim objSheet As Worksheet

    Dim sheetNmArray() As String        'Excelブック内のシート名称(配列)
    ReDim sheetNmArray(1 To sheetCnt)
    Dim matchCnt As Long                '対象のシート名と一致するシート数
    
    'Excelファイル内で条件に一致するシートのみシート名を配列に格納する
    For Each objSheet In ActiveWorkbook.Worksheets
      
        If objSheet.Name Like TgtSheetNm Then
            If ActiveWorkbook.Sheets(objSheet.Name).Visible = True Then
                matchCnt = matchCnt + 1
                sheetNmArray(matchCnt) = objSheet.Name
            End If
        End If
      
    Next
    
    If matchCnt <> 0 Then
        ReDim Preserve sheetNmArray(1 To matchCnt)
    Else
        MsgBox Msg2
        Exit Sub
    End If
    
    ''PDFファイルの保存処理
    Call savePdf(sheetNmArray, 1)
    
End Sub

'===================================
'全シートを対象にして複数のPDFに保存した際の処理
'===================================
Public Sub allSheetForSomePDF_onAction(control As IRibbonControl)

    Dim sheetCnt As Long: sheetCnt = ActiveWorkbook.Worksheets.Count
    Dim sheetNmArray() As String        'Excelブック内のシート名称(配列)
    ReDim sheetNmArray(1 To sheetCnt)
    Dim visShtCnt As Long               '表示中のシート数
    Dim i As Long
    
    '全てのシートを対象にするため配列に全シート名を格納する
    For i = 1 To sheetCnt
        If ActiveWorkbook.Sheets(i).Visible = True Then
            visShtCnt = visShtCnt + 1
            sheetNmArray(visShtCnt) = ActiveWorkbook.Sheets(i).Name
        End If
    Next i
    
    ReDim Preserve sheetNmArray(1 To visShtCnt)
    
    ''PDFファイルの保存処理
    Call savePdf(sheetNmArray, 2, TgtAddFileNm, TgtAddCellPosition, SetPlace)
    
End Sub

'===================================
'指定したシートを対象にして複数のPDFに保存した際の処理
'===================================
Public Sub tgtSheetForSomePDF_onAction(control As IRibbonControl)

    Dim sheetCnt As Long: sheetCnt = ActiveWorkbook.Worksheets.Count
    Dim objSheet As Worksheet
    
    Dim sheetNmArray() As String        'Excelブック内のシート名称(配列)
    ReDim sheetNmArray(1 To sheetCnt)
    Dim matchCnt As Long                '対象のシート名と一致するシート数
    
    'Excelファイル内で条件に一致するシートのみシート名を配列に格納する
    For Each objSheet In ActiveWorkbook.Worksheets
      
        If objSheet.Name Like TgtSheetNm Then
            If ActiveWorkbook.Sheets(objSheet.Name).Visible = True Then
                matchCnt = matchCnt + 1
                sheetNmArray(matchCnt) = objSheet.Name
            End If
        End If
    Next
    
    If matchCnt <> 0 Then
        ReDim Preserve sheetNmArray(1 To matchCnt)
    Else
        MsgBox Msg2
        Exit Sub
    End If
    
    ''PDFファイルの保存処理
    Call savePdf(sheetNmArray, 2, TgtAddFileNm, TgtAddCellPosition, SetPlace)
    
End Sub


'-------------------------
'PDFファイルの保存処理
' 引数:sheetNmArray(対象のシート名が入った配列)
'       processCd(1:一つのPDFファイルで出力、2:複数PDFファイルで出力)
'    opFileNm(ファイル名に追加する名称)
'        opCellPosition(追加するファイル名が入っているセル位置)
'        opAddPosition(ファイル名を追加する位置)#1:最初 #2:最後
'-------------------------
Sub savePdf(sheetNmArray() As String, _
            processCd As Long, _
            Optional opFileNm As String = "", _
            Optional opCellPosition As String = "", _
            Optional opAddPosition As String = "")
    
On Error GoTo errorsyori

    Dim selSheetNm As String
    selSheetNm = ActiveSheet.Name

    Dim objFileSys As Object
    Dim noExtensionFileName As String
    Dim fileName As Variant
    Dim sheetNm As Variant
    Dim addWord As String
    
    'ファイルシステムを扱うオブジェクトを作成
    Set objFileSys = CreateObject("Scripting.FileSystemObject")
     
    '拡張子無しのファイル名を取得
    noExtensionFileName = objFileSys.GetBaseName(ActiveWorkbook.FullName)
    
    '一つのPDFファイルに保存する場合の処理
    If processCd = 1 Then
    
        'PDFファイルの保存先とファイル名称を指定する
        fileName = Application.GetSaveAsFilename(InitialFileName:=noExtensionFileName, FileFilter:="PDF,*.pdf")
        If fileName <> False Then
        
            Worksheets(sheetNmArray).Select
            
            'PDF出力処理
            ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                fileName:=fileName
            
        End If
        
    '複数PDFファイルに保存する場合の処理
    Else

        Dim folderPath As Variant
        
        With Application.FileDialog(msoFileDialogFolderPicker)
            .AllowMultiSelect = False
    
            .Title = Msg1
            If .Show = True Then
                folderPath = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With
        
        For Each sheetNm In sheetNmArray
        
            Dim cellValue As String
            
            If opFileNm <> "" Then
                addWord = opFileNm
            ElseIf opCellPosition <> "" Then
                addWord = CStr(Worksheets(sheetNm).Range(opCellPosition).Value)
            End If
            
            If addWord <> "" Then
                If opAddPosition = "1" Then
                    fileName = folderPath & "\" & addWord & "_" & sheetNm & ".pdf"
                ElseIf opAddPosition = "2" Then
                    fileName = folderPath & "\" & sheetNm & "_" & addWord & ".pdf"
                End If
            Else
                fileName = folderPath & "\" & sheetNm & ".pdf"
            End If
            
            Worksheets(sheetNm).Select
            
            'PDF出力処理
            ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                fileName:=fileName
                    
        Next
    End If
    
    Worksheets(selSheetNm).Select
    Exit Sub
 
errorsyori:
    MsgBox Msg3
    
End Sub

'-------------------------
'「ファイル名に追加」内の項目を選択した際の処理
' 引数:control (選択したコントロール)
'-------------------------
Function getPress_InsertInfo(control As IRibbonControl) As Boolean

    Select Case control.ID
    
        Case "tgl_nothing"                       '「なし」の場合

            If SetValue = ADD_NOTHING Then
                getPress_InsertInfo = True
            Else
                getPress_InsertInfo = False
            End If
            
        Case "tgl_tgtValue"                      '「値を指定」の場合

            If SetValue = ADD_VALUE Then
                getPress_InsertInfo = True
            Else
                getPress_InsertInfo = False
            End If
        
        Case "tgl_tgtCell"                       '「特定のセルから取得」の場合

            If SetValue = ADD_CELL_POINT Then
                getPress_InsertInfo = True
            Else
                getPress_InsertInfo = False
            End If
        
    End Select

End Function

'-------------------------
'「ファイル名に追加」で選択した項目を変更した際の処理
' 引数:control (選択したコントロール)
'-------------------------
Sub change_additionalInfo(control As IRibbonControl)

    Select Case control.ID
    
        Case "tgl_nothing"                       '「なし」を選択した場合
            SetValue = ADD_NOTHING
            TgtAddFileNm = ""
            TgtAddCellPosition = ""
        Case "tgl_tgtValue"                      '「値を指定」を選択した場合
            SetValue = ADD_VALUE
            LblInsertInfo = SET_VALUE_WORD
        Case "tgl_tgtCell"                       '「特定のセルから取得」を選択した場合
            SetValue = ADD_CELL_POINT
            LblInsertInfo = SET_VALUE_CELL
        
    End Select
    
    RbRibbon.InvalidateControl ("edb_AdditionalInfo")
    RbRibbon.InvalidateControl ("tgl_nothing")
    RbRibbon.InvalidateControl ("tgl_tgtValue")
    RbRibbon.InvalidateControl ("tgl_tgtCell")
    RbRibbon.InvalidateControl ("lgl_addPoint")
    RbRibbon.InvalidateControl ("tgl_first")
    RbRibbon.InvalidateControl ("tgl_last")
    
End Sub

'-------------------------
'「追加位置」内の項目を選択した際の処理
' 引数:control (選択したコントロール)
'-------------------------
Function getPress_InsertPoint(control As IRibbonControl) As Boolean

    Select Case control.ID
    
        Case "tgl_first"    '最初を選択した場合
        
            If SetPlace = SET_FIRST Then
                getPress_InsertPoint = True
            Else
                getPress_InsertPoint = False
            End If
        
        Case "tgl_last"     '最後を選択した場合
            
            If SetPlace = SET_LAST Then
                getPress_InsertPoint = True
            Else
                getPress_InsertPoint = False
            End If
        
    End Select

End Function

'-------------------------
'「追加位置」で選択した項目を変更した際の処理
' 引数:control (選択したコントロール)
'-------------------------
Sub change_InsertPoint(control As IRibbonControl)

    Select Case control.ID
    
        Case "tgl_first"        '最初を選択した場合
            SetPlace = SET_FIRST
        
        Case "tgl_last"         '最後を選択した場合
            SetPlace = SET_LAST
        
    End Select

    RbRibbon.InvalidateControl ("tgl_first")
    RbRibbon.InvalidateControl ("tgl_last")
        
End Sub

 

4.ファイルを保存する際は「Excelアドイン(*.xlam)」を選択して、保存します。

これで事前準備は完了です。

 

あとは基本的な機能、操作方法の説明で記載されている通り、アドインを「開発」→「Excelアドイン」→「参照」より上記で保存したExcelアドインファイルを指定すればツールが使用できます。

 

 

なお、当マクロの開発環境は、OS:Windows10 、Excelソフトウェア:Microsoft Office 365となっており、当環境では動作確認ができていますが、他の環境で正常に動作するかは確認できていません。

正常に動作しない場合は、コメントいただければ幸いです。

 

 

また以下にて、このような業務効率化できるツールを機能ごとの一覧でまとめてますので、ご興味のある方はご覧ください。

 

自力で業務効率化できるツール等を作成する場合は、オンラインITスクール」を利用するとモチベーションを保ちつつ、効率的に学習とアウトプットができると思います。

\ 今なら1か月間全額返金保証!! /

上記の「侍テラコヤ」月額2,980円~ という日本最安級の料金でプログラミング学習ができ、今なら初めての方でも安心できる「1か月全額返金保証」があります

自分に合わないと感じた場合は返金してもらえるため、ノーリスクで試すことができます。是非一度体験してみることをオススメします ^ ^

 

ツールのダウンロードはこちら

下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコードをツール内に組み込んで使用してください。

【Excel VBA】Excelのシート毎に分けてPDF出力するツール(パート2)

ツールのダウンロードはこちら
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています

他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います

 

<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>