Excel内にあるテーブルデータを他のシート内に入れ込んでいく(差し込む)場合にどのように操作して実行してますでしょうか。
一つずつデータを入力して変更があった場合は、その都度シート内の値を変更して。。。
というようにとても大変な思いをしているのではないでしょうか。
そんな場面で、無駄な作業が効率化するために、もっと便利に簡単に行えるように『テーブルのデータを複数のシートに差し込むツール』をExcelマクロ(アドイン)で作りました。
これは簡単に言うと、WordにあってExcelにない機能である「差し込み印刷」!!
Excelで差し込み印刷を使いたいと思ったので、このような機能をExcelマクロのアドインで実装してみました。
当記事にはマクロの元になるExcelファイルがダウンロード可能で、VBAのコードも記事内に記載がありますので、Excel VBAやマクロが良く分からないという方でもすぐに使用できます。
当ツールを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。
Excel差込出力のマクロアドインの概要
ExcelにVBAコードを入れてマクロを作成し、アドインとして保存します。
そのアドインを取り込むとリボンに『差し込み』のタブが表示されるので、そこからデータを取得するテーブルを選択して、テーブル内の項目をセル内に貼り付ければ、複数シートにまたがって各シートにテーブルデータを貼り付けることができます。
基本的な機能、操作方法の説明
- 当Excelアドインツールを使用したい任意のExcelファイルを開きます。
- 「開発」タブの「Excelアドイン」より、作成したアドインファイルを指定(参照)します。
リボンに『差し込み』が表示されて、クリックすると『データ差し込み』が表示されます。
<手順1> (#セル内に差し込みたい項目を指定する)
- 貼り付けたい任意のセルを選択します。
- 「テーブル名」よりデータを取得するテーブルを選択します。
- 「項目を挿入」よりセル内に差し込みたいテーブル内の項目を選択します。
項目を選択すると、≪#項目名» という構成でセル内に入力されます。
『テーブル名』で選択できる値について
テーブル名にはファイル内に存在するテーブルが一覧で表示されており、一つを選択することができます。
<手順2> (#項目に紐づくデータに反映させる)
- 「反映」ボタンをクリックします。
手順1の項目名のセルに、選択したテーブル内の対応するデータが差し込まれます。
『対象シート』で選択できる値について
対象シートには「全シート」とファイル内にある全シートの名称が表示されており、一つを選択することができます。
『項目を挿入』で選択できる値について
項目を挿入では、テーブル名で選択したテーブルの項目が一覧で表示されており、一つを選択することでセル内に挿入することができます。
「反映」を実施した際にテーブルデータが差し込まれるルールは、この後に記載の補足事項を参照ください。
<手順3> ※差し込まれたデータを項目に戻す場合
- 「戻す」ボタンをクリックします。
<手順4> (#差し込まれた状態でPDF出力する)
- 「差し込み出力」ボタンを選択します。
- 表示されたメニューから「選択した対象シートをPDF出力」を選択します。
選択した対象シートというのが、左側にある「対象シート」で選択されているシートのことを示しています。
シート内のセルにテーブル項目(≪#項目名»の表示)が指定されている場合は、テーブルデータを差し込んでからPDFにて出力されます。
補足説明
対象シートを『全シート』にした際の挙動について
手順2(#項目に紐づくデータに反映させる)に関して、対象シートを『全シート』にして「反映」を実施すると、ファイル内にある全シートの中で、テーブルデータの項目が存在するシートに対して、左にあるシートから順番にテーブルデータを差し込んでいきます。
『勤務管理表』、『勤務管理表(2)』、『勤務管理表(3)』の3つのシートにそれぞれテーブルデータ存在する場合は、以下の挙動になります。
差し込むルールとしては、テーブルの項目が存在するシートを対象にして、(①テーブルデータの上から順番に②シートの左から順番に)項目に対してデータを差し込んでいきます。
対象シートで任意のシートを選択した際の挙動について
対象シートを『全シート』でなく一つのシートを選択(例では『勤怠管理表(2)』)して「反映」を実施した場合
選択したシートのみ、テーブルの一番上にあるデータが差し込まれ、他シートにはデータは差し込まれません。
使用する際の事前準備
このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。
以下にその手順を説明していきます。
準備の手順
「サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードします。
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています。
<手順1>
ダウンロードしたExcelファイルを開いて、VBE(Visual Basic Editor)を起動させます。
- Excelファイル上部にあるリボンの「開発」タブを選択します。
- 「Visual Basic」をクリックして、VBE(Visual Basic Editor)を起動させます。
リボンに「開発」タブが表示されていない場合は、以下を参照ください。
(参考サイト:記事「Excel VBAを始める前に、最初にやっておくべき初期設定内容はこれ」の『開発』タブを表示させる)
<手順2>
- 「Microsoft Excel Object」にて右クリックして「標準モジュール」を挿入します。
<手順3>
- 新しく作成された「Module1」を選択して、右側の空欄スペース(エディター)に下記のVBAコードをコピペで入力します。
VBAのソースコードはこちら
以下のVBAコードをコピーして、「Module1」内のエディターに貼り付けます。
※VBAコードの右上のアイコンをクリックするとソースコードをコピーできます
Option Explicit
'-----(設定値)------------------------
Private Const All_SHEET = "全シート" '1.全シートを選択する時のシート名
'---------------------------------------
Private RbRibbon As IRibbonUI 'リボン
Private TableItems As Variant 'テーブル名(配列)
Private SelectedTableNm As String '選択したテーブル名
Private ColumnItems As Variant '項目名(配列)
Private SelectedColumnNm As String '選択した項目
Private SheetItems As Variant 'シート名(配列)
Private SelectedSheetNm As String '選択したシート名
Private MatchRange As Range '検索して一致した項目(range)
Private DicMatchRange As Object '一致した項目を保存するオブジェクト
Private PrintSheets As Variant '印刷する際のシート
'---------(メッセージ)-----------------------
Private Const Msg1 = "PDFファイルで出力が完了しました。"
Private Const Msg2 = "PDFファイルが既に開かれています。" & vbLf & "ファイルを閉じてから再度実行して下さい。"
'----------------------------------------------
'===================================
'リボンの初期処理
'===================================
Sub onLoad_dataInset(ribbon As IRibbonUI)
'リボンの表示を更新できるようにするためにリボンをセットする
Set RbRibbon = ribbon
RbRibbon.Invalidate
Call getDataTables 'テーブルデータを取得
Call getColumns '項目データを取得
Call getSheets 'シート名を取得
Set DicMatchRange = CreateObject("Scripting.Dictionary")
End Sub
'===================================
'テーブルを取得をクリックした際の処理
'===================================
Public Sub btn_getDataTable_onClick(control As IRibbonControl)
SelectedTableNm = ""
Call getDataTables 'テーブルデータを取得
Call getColumns '項目データを取得
Call getSheets 'シート名を取得
RbRibbon.InvalidateControl "drdn_dataTable"
RbRibbon.InvalidateControl "DMn_insertItem"
RbRibbon.InvalidateControl "drdn_sheetName"
RbRibbon.InvalidateControl "btn_influence"
RbRibbon.InvalidateControl "btn_return"
RbRibbon.InvalidateControl "Mn_print"
End Sub
'=== テーブル名(ドロップダウンリスト)===================================== start ===
Public Sub drdn_dataTable_getItemCount(control As IRibbonControl, ByRef returnedVal)
If UBound(TableItems) <> -1 Then
returnedVal = UBound(TableItems) + 1
End If
End Sub
Public Sub drdn_dataTable_getItemID(control As IRibbonControl, index As Integer, ByRef returnedVal)
returnedVal = "tableItem" & index
End Sub
Public Sub drdn_dataTable_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
returnedVal = TableItems(index)
End Sub
Public Sub drdn_dataTable_getSelectedItemID(control As IRibbonControl, ByRef returnedVal)
If UBound(TableItems) <> -1 Then
SelectedTableNm = TableItems(0)
End If
returnedVal = "tableItem0"
End Sub
Public Sub drdn_dataTable_getEnabled(control As IRibbonControl, ByRef returnedVal)
If UBound(TableItems) = -1 Then
returnedVal = False
Else
returnedVal = True
End If
End Sub
' == テーブル名を選択した際の処理 ====
Public Sub drdn_dataTable_onClick(control As IRibbonControl, id As String, index As Integer)
SelectedTableNm = TableItems(index)
Call getColumns '項目データを取得
Call getSheets 'シート名を取得
PrintSheets = Array()
ReDim Preserve PrintSheets(0)
RbRibbon.InvalidateControl "DMn_insertItem"
RbRibbon.InvalidateControl "drdn_sheetName"
RbRibbon.InvalidateControl "btn_influence"
RbRibbon.InvalidateControl "btn_return"
RbRibbon.InvalidateControl "Mn_print"
End Sub
'=== 項目を挿入(ダイナミックメニュー)===================================== start ===
Public Sub DMn_getContent(control As IRibbonControl, ByRef returnedVal)
returnedVal = getContents()
End Sub
Public Sub DMn_getEnabled(control As IRibbonControl, ByRef returnedVal)
If UBound(ColumnItems) = -1 Then
returnedVal = False
Else
returnedVal = True
End If
End Sub
' == 項目を選択した際の処理 ====
Public Sub btnItem_onAction(control As IRibbonControl)
SelectedColumnNm = ColumnItems(Split(control.id, "Item")(1))
Dim c As Range
Set c = Selection
c.Value = "≪#" & SelectedColumnNm & "≫"
End Sub
'=== シート名(ドロップダウンリスト)======================================= start ===
Public Sub drdn_sheetName_getEnabled(control As IRibbonControl, ByRef returnedVal)
If UBound(SheetItems) = -1 Or SheetItems(0) = "" Then
returnedVal = False
Else
returnedVal = True
End If
End Sub
Public Sub drdn_sheetName_getItemCount(control As IRibbonControl, ByRef returnedVal)
If UBound(SheetItems) <> -1 Then
returnedVal = UBound(SheetItems) + 1
End If
End Sub
Public Sub drdn_sheetName_getItemID(control As IRibbonControl, index As Integer, ByRef returnedVal)
returnedVal = "sheetItem" & index
End Sub
Public Sub drdn_sheetName_getItemLabel(control As IRibbonControl, index As Integer, ByRef returnedVal)
returnedVal = SheetItems(index)
End Sub
Public Sub drdn_sheetName_getSelectedItemID(control As IRibbonControl, ByRef returnedVal)
If UBound(SheetItems) <> -1 Then
SelectedSheetNm = SheetItems(0)
End If
returnedVal = "sheetItem0"
End Sub
' == 対象シートを選択した際の処理 ====
Public Sub drdn_sheetName_onClick(control As IRibbonControl, id As String, index As Integer)
SelectedSheetNm = SheetItems(index)
End Sub
'=== 反映ボタン ============================================================ start ===
Public Sub btn_influence_getEnabled(control As IRibbonControl, ByRef returnedVal)
If UBound(SheetItems) = -1 Or SheetItems(0) = "" Then
returnedVal = False
Else
returnedVal = True
End If
End Sub
' == 反映ボタンをクリックした際の処理 ====
Public Sub btn_influence_onClick(control As IRibbonControl)
Call influenceItem '項目をテーブルデータで反映
End Sub
'=== 戻すボタン ============================================================ start ===
Public Sub btn_return_getEnabled(control As IRibbonControl, ByRef returnedVal)
If UBound(SheetItems) = -1 Or SheetItems(0) = "" Then
returnedVal = False
Else
returnedVal = True
End If
End Sub
' == 戻すボタンをクリックした際の処理 ====
Public Sub btn_return_onClick(control As IRibbonControl)
Dim tmpSheet As Worksheet
'対象ファイルの全シートを1つずつループして処理する
For Each tmpSheet In ActiveWorkbook.Worksheets
If SelectedSheetNm = All_SHEET Or tmpSheet.Name = SelectedSheetNm Then
Dim tgtKeys As Variant
Dim tgtSheetRange As Variant
Dim tgtItemValue As Variant
For Each tgtKeys In DicMatchRange.Keys
tgtSheetRange = Split(tgtKeys, "/")
'項目名をテーブルデータで置換する
tmpSheet.Range(tgtSheetRange(1)).Replace What:=tgtSheetRange(3), Replacement:=tgtSheetRange(2), _
LookAt:=xlPart, MatchCase:=True, matchbyte:=True
Next
End If
Next
End Sub
'=== 差し込み出力ボタン ==================================================== start ===
Public Sub Mn_print_getEnabled(control As IRibbonControl, ByRef returnedVal)
If UBound(SheetItems) = -1 Or SheetItems(0) = "" Then
returnedVal = False
Else
returnedVal = True
End If
End Sub
' == 「選択した対象シートを出力」をクリックした際の処理 ====
Public Sub btn_partPrint_onAction(control As IRibbonControl)
Call influenceItem '項目をテーブルデータで反映
Call savePdf(PrintSheets) 'PDF出力
End Sub
'-----------------------------------
'テーブルデータを取得する処理
'-----------------------------------
Private Sub getDataTables()
Dim ws As Variant, tempT As Variant, i As Long
TableItems = Array()
ReDim Preserve TableItems(i)
TableItems(i) = ""
i = i + 1
'すべてのシートをループ
For Each ws In Worksheets
'シート内で、すべてのテーブルをループ
For Each tempT In ws.ListObjects
ReDim Preserve TableItems(i)
'テーブル名を取得
TableItems(i) = tempT.Name
i = i + 1
Next
Next
End Sub
'-----------------------------------
'表示させる項目を取得する処理
'-----------------------------------
Private Function getContents() As String
Dim domD As Object
Dim elmMenu As Object
Dim elmButton As Object
Dim i As Long
Set domD = CreateObject("Msxml2.DOMDocument")
Set elmMenu = domD.createElement("menu")
elmMenu.setAttribute "xmlns", "http://schemas.microsoft.com/office/2006/01/customui"
elmMenu.setAttribute "itemSize", "normal"
For i = 0 To UBound(ColumnItems)
'表示させる項目をボタン形式で設定する
Set elmButton = domD.createElement("button")
With elmButton
.setAttribute "id", "columnItem" & i
.setAttribute "label", ColumnItems(i)
.setAttribute "imageMso", "InkingStart"
.setAttribute "onAction", "btnItem_onAction"
End With
elmMenu.appendChild elmButton
Set elmButton = Nothing
Next
'作成したxmlを反映させる
domD.appendChild elmMenu
getContents = domD.XML
End Function
'-----------------------------------
'テーブル内の項目を取得する処理
'-----------------------------------
Private Sub getColumns()
Dim i As Long
Dim col As ListColumn
Dim wlo As Variant
Dim ws As Worksheet
Dim tempTable As Variant
ColumnItems = Array()
If SelectedTableNm <> "" Then
'すべてのシートをループ
For Each ws In ActiveWorkbook.Sheets
'シート内で、全てのテーブルをループ
For Each tempTable In ws.ListObjects
If tempTable.Name = SelectedTableNm Then
For Each col In ws.ListObjects(SelectedTableNm).ListColumns
ReDim Preserve ColumnItems(i)
'項目名を取得
ColumnItems(i) = col.Name
i = i + 1
Next
End If
Next
Next
End If
End Sub
'-----------------------------------
'シート名の値を取得する処理
'-----------------------------------
Private Sub getSheets()
Dim ws As Variant, tempT As Variant, i As Long
SheetItems = Array()
If SelectedTableNm <> "" Then
'要素数を宣言
ReDim Preserve SheetItems(i)
SheetItems(i) = All_SHEET
i = i + 1
'すべてのシートをループ
For Each ws In Worksheets
ReDim Preserve SheetItems(i)
'シート名を取得
SheetItems(i) = ws.Name
i = i + 1
Next
Else
ReDim Preserve SheetItems(0)
SheetItems(0) = ""
End If
End Sub
'--------------------------------------------
'項目を対応したテーブルデータに反映する処理
'--------------------------------------------
Private Sub influenceItem()
Dim tmpSheet As Worksheet
Dim tgtRowNum As Long: tgtRowNum = 1
Dim tgtSheetNum As Long
Dim i As Long
Dim isExist As Boolean
Dim searchSheets() As String
'対象ファイルの全シートを1つずつループして処理する
For Each tmpSheet In ActiveWorkbook.Worksheets
If SelectedSheetNm = All_SHEET Or tmpSheet.Name = SelectedSheetNm Then
Dim aList As ListObject
Set aList = Range(SelectedTableNm).ListObject
Dim col As ListColumn
Dim fAddress As String
'列の種類だけ実行する
For Each col In aList.ListColumns
'検索して一致した範囲を保存しておく。
Set MatchRange = tmpSheet.Cells.Find(What:="≪#" & col.Name & "≫", _
LookAt:=xlPart, MatchCase:=True, matchbyte:=True)
If Not MatchRange Is Nothing Then
'列のデータ数分だけ実行する
For i = tgtRowNum To aList.ListColumns(col.Name).DataBodyRange.Count
fAddress = MatchRange.Address
Do
Set MatchRange = tmpSheet.Cells.FindNext(MatchRange)
If MatchRange Is Nothing Then Exit Do
'辞書オブジェクトに既に登録されている場合は、登録処理をしない
If DicMatchRange.exists(tmpSheet.Name & "/" & MatchRange.Address & "/" & "≪#" & col.Name & "≫" & "/" & aList.ListColumns(col.Name).DataBodyRange(i)) = False Then
DicMatchRange.Add tmpSheet.Name & "/" & MatchRange.Address & "/" & "≪#" & col.Name & "≫" & "/" & aList.ListColumns(col.Name).DataBodyRange(i), ""
End If
Loop Until MatchRange.Address = fAddress
'項目名を該当する値に置換する
tmpSheet.Cells.Replace What:="≪#" & col.Name & "≫", Replacement:=aList.ListColumns(col.Name).DataBodyRange(i), _
LookAt:=xlPart, MatchCase:=True, matchbyte:=True
isExist = True
Exit For
Next
searchSheets = Filter(PrintSheets, tmpSheet.Name)
If UBound(searchSheets) = -1 Then
ReDim Preserve PrintSheets(tgtSheetNum)
PrintSheets(tgtSheetNum) = tmpSheet.Name
tgtSheetNum = tgtSheetNum + 1
End If
End If
Next
If isExist Then tgtRowNum = tgtRowNum + 1
End If
Next
End Sub
'-------------------------
'PDFファイルの保存処理
' 引数:sheetNmArray(対象のシート名が入った配列)
'-------------------------
Sub savePdf(sheetNmArray As Variant)
On Error GoTo Err1
Dim selSheetNm As String
selSheetNm = ActiveSheet.Name
Dim objFileSys As Object
Dim noExtensionFileName As String
Dim fileName As Variant
Dim sheetNm As Variant
'ファイルシステムを扱うオブジェクトを作成
Set objFileSys = CreateObject("Scripting.FileSystemObject")
'拡張子無しのファイル名を取得
noExtensionFileName = objFileSys.GetBaseName(ActiveWorkbook.FullName)
'PDFファイルの保存先とファイル名称を指定する
fileName = Application.GetSaveAsFilename(InitialFileName:=noExtensionFileName, FileFilter:="PDF,*.pdf")
If fileName <> False Then
Worksheets(sheetNmArray).Select
'PDF出力処理
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=fileName
MsgBox Msg1
End If
Worksheets(selSheetNm).Select
Exit Sub
Err1:
If Err.Number <> 0 Then
MsgBox Msg2
End If
End Sub
<手順4>
マクロを含んだExcelとして、ファイルを保存します。
- 左上にある「保存」アイコンをクリックします。
- 「ファイルの種類」から「Excelアドイン(*.xlam)」を選択します。
- 「保存」をクリックします。
これで事前準備は完了です。
あとは「基本的な機能、操作方法の説明」で記載された方法でツールを実行できます。
なお、当マクロの開発環境は、OS:Windows10 、Excelソフトウェア:Microsoft Office 365となっており、当環境では動作確認ができていますが、他の環境で正常に動作するかは確認できていません。
正常に動作しない場合は、コメントいただければ幸いです。
また以下にて、このような業務効率化できるツールを機能ごとの一覧でまとめてますので、ご興味のある方はご覧ください。
自力で業務効率化できるツール等を作成する場合は、「オンラインITスクール」を利用するとモチベーションを保ちつつ、効率的に学習とアウトプットができると思います。
上記の「侍テラコヤ」は月額2,980円~ という日本最安級の料金でプログラミング学習ができ、今なら初めての方でも安心できる「1か月全額返金保証」があります。
自分に合わないと感じた場合は返金してもらえるため、ノーリスクで試すことができます。是非一度体験してみることをオススメします ^ ^
ツールのダウンロードはこちら
下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコードをツール内に組み込んで使用してください。
【Excel VBA】Excel差し込み出力ツール
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています
他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います。
<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>