【ExcelVBA】VBAによるExcelのフォーマット自動修正 #VBAマクロ

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