VBAを使用したツール作成まとめ
はじめに
VBAを使用したドキュメントのレビューツールを作成したため、実装した機能のまとめを踏まえた記事となります。
記載のコードはVBAの標準モジュールにそのまま貼り付け、セルに必要な値を記入することで動作いたします。
1.セル値のフォント自動変更
- 現在のブックのシート1のセルA1からフォント名を取得します。
- 同じシートのセルA2から変更するExcelファイルのパスを取得します。
- 取得したパスのExcelファイルを開きます。
- 開いたファイルの全シート、各シート全セルのフォントを指定されたフォントに変更します。
- 変更後、ファイルを保存して閉じます。
Sub ChangeFont()
Dim wb As Workbook
Dim ws As Worksheet
Dim cell As Range
Dim fontName As String
Dim folderPath As String
Dim fileName As String
Dim fso As Object
Dim folder As Object
Dim file As Object
' セルA1のフォント名を取得
fontName = ThisWorkbook.Sheets(1).Range("A1").Value
' セルA2のフォルダパスを取得
folderPath = ThisWorkbook.Sheets(1).Range("A2").Value
' フォルダパスの末尾に\を追加（必要な場合）
If Right(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
' FileSystemObjectを作成
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
' フォルダ内の全ファイルをループ
For Each file In folder.Files
' Excelファイルのみ処理（拡張子をチェック）
If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Or LCase(fso.GetExtensionName(file.Name)) = "xls" Then
' ファイルを開く
Set wb = Workbooks.Open(file.Path)
' 全シートをループ
For Each ws In wb.Worksheets
' シート内の全セルをループ
For Each cell In ws.UsedRange
' フォントを変更
cell.Font.Name = fontName
Next cell
Next ws
' ファイルを保存して閉じる
wb.Close SaveChanges:=True
End If
Next file
End Sub
2. セル値の文字サイズ自動変更
- 現在のブックのシート1のセルA1から文字サイズを取得します。
- 同じシートのセルA2からフォルダパスを取得します。
- 指定されたフォルダ内のすべてのExcelファイルをループします。
- 開いたファイルの全シート、各シート全セルの文字サイズを指定されたサイズに変更します。
- 変更後、ファイルを保存して閉じます。
Sub ChangeFontSize()
Dim wb As Workbook
Dim ws As Worksheet
Dim cell As Range
Dim fontSize As Double
Dim folderPath As String
Dim fileName As String
Dim fso As Object
Dim folder As Object
Dim file As Object
' セルA1のフォントサイズを取得
fontSize = ThisWorkbook.Sheets(1).Range("A1").Value
' セルA2のフォルダパスを取得
folderPath = ThisWorkbook.Sheets(1).Range("A2").Value
' フォルダパスの末尾に\を追加（必要な場合）
If Right(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
' FileSystemObjectを作成
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
' フォルダ内の全ファイルをループ
For Each file In folder.Files
' Excelファイルのみ処理（拡張子をチェック）
If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Or LCase(fso.GetExtensionName(file.Name)) = "xls" Then
' ファイルを開く
Set wb = Workbooks.Open(file.Path)
' 全シートをループ
For Each ws In wb.Worksheets
' シート内の全セルをループ
For Each cell In ws.UsedRange
' フォントサイズを変更
cell.Font.Size = fontSize
Next cell
Next ws
' ファイルを保存して閉じる
wb.Close SaveChanges:=True
End If
Next file
End Sub
3. テキストボックス、図形のフォント自動変更
- 現在のブックのシート1のセルA1からフォント名を取得します。
- 同じシートのセルA2からフォルダパスを取得します。
- 指定されたフォルダ内のすべてのExcelファイルをループします。
- 開いたファイルの全シート、すべての図形（テキストボックスや図形）をループし、フォントを指定されたフォントに変更します。
- 変更後、ファイルを保存して閉じます。
Sub ChangeFontInShapes()
Dim wb As Workbook
Dim ws As Worksheet
Dim shp As Shape
Dim fontName As String
Dim folderPath As String
Dim fso As Object
Dim folder As Object
Dim file As Object
' セルA1からフォント名を取得
fontName = ThisWorkbook.Sheets(1).Range("A1").Value
' セルA2からフォルダパスを取得
folderPath = ThisWorkbook.Sheets(1).Range("A2").Value
' フォルダパスの末尾に\を追加（必要な場合）
If Right(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
' FileSystemObjectを作成
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
' フォルダ内の全ファイルをループ
For Each file In folder.Files
' Excelファイルのみ処理（拡張子をチェック）
If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Or LCase(fso.GetExtensionName(file.Name)) = "xls" Then
' ファイルを開く
Set wb = Workbooks.Open(file.Path)
' 全シートをループ
For Each ws In wb.Worksheets
' シート内の全図形をループ
For Each shp In ws.Shapes
If shp.HasTextFrame Then
If Not shp.TextFrame2.TextRange Is Nothing Then
shp.TextFrame2.TextRange.Font.Name = fontName
shp.TextFrame2.TextRange.Font.NameFarEast = fontName
ElseIf Not shp.TextFrame.TextRange Is Nothing Then
shp.TextFrame.TextRange.Font.Name = fontName
shp.TextFrame.TextRange.NameFarEast = fontName
End If
End If
Next shp
Next ws
' ファイルを保存して閉じる
wb.Close SaveChanges:=True
End If
Next file
End Sub
4. テキストボックス、図形の文字サイズ自動変更
- 現在のブックのシート1のセルA1から文字サイズを取得します。
- 同じシートのセルA2からフォルダパスを取得します。
- 指定されたフォルダ内のすべてのExcelファイルをループします。
- 開いたファイルの全シート、すべての図形（テキストボックスや図形）をループし、文字サイズを指定されたサイズに変更します。
- 変更後、ファイルを保存して閉じます。
Sub ChangeFontSize()
Dim wb As Workbook
Dim ws As Worksheet
Dim shp As Shape
Dim fontSize As Integer
Dim folderPath As String
Dim fso As Object
Dim folder As Object
Dim file As Object
' セルA1から文字サイズを取得
fontSize = ThisWorkbook.Sheets(1).Range("A1").Value
' セルA2からフォルダパスを取得
folderPath = ThisWorkbook.Sheets(1).Range("A2").Value
' フォルダパスの末尾に\を追加（必要な場合）
If Right(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
' FileSystemObjectを作成
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath)
' フォルダ内の全ファイルをループ
For Each file In folder.Files
' Excelファイルのみ処理（拡張子をチェック）
If LCase(fso.GetExtensionName(file.Name)) = "xlsx" Or LCase(fso.GetExtensionName(file.Name)) = "xls" Then
' ファイルを開く
Set wb = Workbooks.Open(file.Path)
' 全シートをループ
For Each ws In wb.Worksheets
' シート内の全図形をループ
For Each shp In ws.Shapes
If shp.HasTextFrame Then
If Not shp.TextFrame2.TextRange Is Nothing Then
shp.TextFrame2.TextRange.Font.Size = fontSize
ElseIf Not shp.TextFrame.TextRange Is Nothing Then
shp.TextFrame.TextRange.Font.Size = fontSize
End If
End If
Next shp
Next ws
' ファイルを保存して閉じる
wb.Close SaveChanges:=True
End If
Next file
End Sub
5. まとめ
今回VBAを作成するに加え、関数使用方法、記載方法を学ぶことができました。
今回はサブプロシージャを使用しましたが、複雑な処理を書く上で共通処理を関数化し、値を返す必要がある場合は、Function プロシージャを使用することが多くなると思います。
株式会社ジールでは、「ITリテラシーがない」「初期費用がかけられない」「親切・丁寧な支援がほしい」「ノーコード・ローコードがよい」「運用・保守の手間をかけられない」などのお客様の声を受けて、オールインワン型データ活用プラットフォーム「ZEUSCloud」を月額利用料にてご提供しております。
ご興味がある方は是非下記のリンクをご覧ください：
https://www.zdh.co.jp/products-services/cloud-data/zeuscloud/?utm_source=qiita&utm_medium=referral&utm_campaign=qiita_zeuscloud_content-area