はじめに

こんにちは、SAKURUGのTakumiです。

どこの現場でもExcelを使用することはたくさんあると思います。

めんどくさい作業を自動で行いたいや作業時間短縮したいなど思ったことある方もいると思います。

今回は開発現場で使えそうなVBAマクロ(第一弾)としていくつか紹介したいと思います。

また、VBAが詳しくない方もVBAを学べるようにコードにコメントをつけているので紹介しているもので簡単なものから理解を深め、学んでもらえればと思います。

紹介するマクロ

①選択したセル範囲のサイズ（幅×高さ）に合わせて画像を貼り付け

②テーブル仕様書からSQL(CREATE TABLE)の作成

③処理の進み具合を視覚的に確認できるタスクバーの表示

①選択したセル範囲のサイズ（幅×高さ）に合わせて画像を貼り付け

画像は普通にエクセルの機能の挿入から画像を張り付ければいいのですが、サイズや位置を自動調整してくれるというメリットはあります。

設計書や仕様書へ多くの画面レイアウトのスクリーンショットの貼り付けを行う際に便利です。

手順

１．Excelで、画像を貼りたいセル範囲（1セルでも複数でもOK）を選択

２．マクロ「InsertImageToSelectedRange」を実行

　　※今回はボタンにマクロを割り当てているため、「実行ボタン」をクリック

３．ファイル選択ダイアログで表示させたい画像を選ぶ

４．選択範囲にぴったりサイズで画像が貼り付きます

サンプルコード

Sub InsertImageToSelectedRange()
    Dim selectedRange As Range
    Dim imgPath As String
    Dim imgLeft As Double, imgTop As Double
    Dim imgWidth As Double, imgHeight As Double
    Dim imgShape As Shape

    ' セル範囲の確認
    If TypeName(Selection) <> "Range" Then
        MsgBox "セル範囲を選択してください。", vbExclamation
        Exit Sub
    End If
    Set selectedRange = Selection

    ' 画像ファイル選択
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "画像ファイルを選択してください"
        .Filters.Clear
        .Filters.Add "画像ファイル", "*.jpg; *.jpeg; *.png; *.bmp; *.gif"
        .AllowMultiSelect = False

        If .Show <> -1 Then Exit Sub ' キャンセル時終了
        imgPath = .SelectedItems(1)
    End With

    ' セル範囲のサイズと位置を取得
    imgLeft = selectedRange.Left
    imgTop = selectedRange.Top
    imgWidth = selectedRange.Width
    imgHeight = selectedRange.Height

    ' Shapes.AddPictureで画像を挿入
    Set imgShape = ActiveSheet.Shapes.AddPicture( _
        Filename:=imgPath, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, _
        Left:=imgLeft, _
        Top:=imgTop, _
        Width:=imgWidth, _
        Height:=imgHeight)

    ' 画像の比率を変えたくない場合はmsoTrueに変更
    imgShape.LockAspectRatio = msoFalse

    MsgBox "画像を貼り付けました。", vbInformation
End Sub

補足

・ 「.LockAspectRatio = msoFalse」にしているため、画像は強制的にセルサイズに合わせて引き伸ばし・縮小されます。画像の比率を守りたい場合は「msoTrue」に変更してください。

・貼り付け位置は、選択箇所の最初のセルの左上に合わせています。

②テーブル仕様書からSQL(CREATE TABLE)の作成

テーブル仕様書からSQLを作成します。

今回は決まった形式でコードを作成しておりますが、拡張機能をつけたり、紹介するサンプルコードを応用して他の形式の仕様書に対応するコードを作成することも可能なのでぜひ試してみてください。

前提条件

サンプルコードを実行するには以下の条件を満たす必要があります。

・以下の形式のテーブル仕様書を用意してください。

　※今回紹介するコードの場合、参考例のようにシート左上のA1セルから表を作成する必要があります。

・シート名をテーブル名にしてください。

手順

１．マクロ「GenerateCreateTableSQL」を実行。

　　※今回はボタンにマクロを割り当てているため、「実行ボタン」をクリック

２．作成したい仕様書のシート名を入力する。入力後は「OK」ボタンを押す。

３．以下のようなメッセージが表示され、メモ帳に作成したSQLが表示されます。

　　また、作成したSQLは自動的にデスクトップ上に「SQL.txt」として保存されます。

サンプルコード

Sub GenerateCreateTableSQL()
    Dim sheetName As String
    Dim lastRow As Long
    Dim i As Long
    Dim tableName As String
    Dim sql As String
    Dim pkList As String
    Dim colLine As String
    Dim tempFilePath As String
    Dim fileNum As Integer
    
    'シート名の取得
    sheetName = InputBox("作成したい仕様書のシート名を入力してください")
    If sheetName = "" Then Exit Sub
    Worksheets(sheetName).Activate
    
    tableName = sheetName

    ' データの最終行（列名があるA列）
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    'SQL作成
    sql = "CREATE TABLE " & tableName & " (" & vbCrLf
    pkList = ""

    For i = 2 To lastRow
        Dim colName As String, colType As String
        Dim allowNull As String, isPK As String, defaultVal As String
        
        colName = Trim(Cells(i, 1).Value)
        colType = Trim(Cells(i, 2).Value)
        allowNull = Trim(Cells(i, 3).Value)
        isPK = Trim(Cells(i, 4).Value)
        defaultVal = Trim(Cells(i, 5).Value)

        ' カラム定義作成
        colLine = "    " & colName & " " & colType

        ' デフォルト値
        If defaultVal <> "" Then
            If IsNumeric(defaultVal) Or UCase(defaultVal) = "NULL" Then
                colLine = colLine & " DEFAULT " & defaultVal
            Else
                colLine = colLine & " DEFAULT '" & defaultVal & "'"
            End If
        End If

        ' NULL制約
        If UCase(allowNull) = "NOT NULL" Then
            colLine = colLine & " NOT NULL"
        End If

        ' カンマ追加（後でPRIMARY KEYがあるかもなので後で処理）
        sql = sql & colLine & "," & vbCrLf

        ' 主キーを収集
        If isPK = "○" Or UCase(isPK) = "PK" Then
            If pkList <> "" Then pkList = pkList & ", "
            pkList = pkList & colName
        End If
    Next i

    ' 主キー定義を追加
    If pkList <> "" Then
        sql = sql & "    PRIMARY KEY (" & pkList & ")" & vbCrLf
    Else
        ' 最後のカンマを削除（主キーがない場合）
        sql = Left(sql, Len(sql) - 3) & vbCrLf
    End If

    sql = sql & ");"
    
    ' 出力先パス(デスクトップ上に出力)
    tempFilePath = Environ("USERPROFILE") & "\Desktop\SQL.txt"
    
    ' メモ帳に書き出し
    fileNum = FreeFile
    Open tempFilePath For Output As #fileNum
    Print #fileNum, sql
    Close #fileNum

    ' メモ帳で開く
    Shell "notepad.exe " & Chr(34) & tempFilePath & Chr(34), vbNormalFocus

    MsgBox "CREATE文をデスクトップ上に「SQL.txt」で出力しました。"
End Sub

③処理の進み具合を視覚的に確認できるタスクバーの表示

Excelで大量のデータを使ってマクロを実行していると、Excelがフリーズしたように見えることがあります。

そんな時に視覚的に確認できるタスクバー（進捗バー）を表示することにより、処理の進み具合を簡単に確認することができます。

前提条件

サンプルコードを実行するには以下の条件を満たす必要があります。

・Windows環境である（Sleep関数が使える）。

・対象シートのデータが適切に入っている。

　＞A列に数値が入っていること（コードでは「数値でなければエラー」としているため）。

　＞1行目はヘッダー、2行目から処理対象の数値を入れること。

手順

１．前提条件で作成したシートを開き、マクロ「ProcessWithVisibleProgressBar」を実行。
　　※今回はボタンにマクロを割り当てているため、「実行ボタン」をクリック。

２．ステータスバーで処理の進捗が表示される。

　　Excel画面左下のステータスバーに「■□□□...」のようなバーが表示され、進んでいきます。

３．処理終了後、完了メッセージが表示される。また、エラーがあった場合はログファイルが保存され、そのパスも表示されます。

サンプルコード

' Sleep関数（ミリ秒待機用）をOSのバージョンに合わせて宣言
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Sub ProcessWithVisibleProgressBar()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim total As Long
    Dim progress As Double
    Dim logPath As String
    Dim errorMsg As String
    Dim barLength As Integer
    Dim filledBars As Integer
    Dim progressBar As String

    Set ws = ActiveSheet

    ' データ最終行の取得（A列基準）
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    total = lastRow - 1  ' ヘッダー1行分を除外

    barLength = 20  ' プログレスバーの長さ（文字数）

    ' エラーログファイルのパス設定
    logPath = ThisWorkbook.Path & "\ErrorLog_" & Format(Now, "yyyymmdd_HHmmss") & ".txt"
    Open logPath For Output As #1  ' ログファイルを開く

    ' 2行目から最終行まで繰り返し処理
    For i = 2 To lastRow
        On Error GoTo ErrorHandler

        ' =============================
        ' 任意の処理
        ' =============================
        ' A列が数値かチェック、違えばエラー
        If Not IsNumeric(ws.Cells(i, 1).Value) Then
            Err.Raise vbObjectError + 1, , "A列が数値ではありません。"
        End If

        ' B列に2倍した値を出力
        ws.Cells(i, 2).Value = ws.Cells(i, 1).Value * 2
        ' =============================
        
        ' プログレスバーを作成・表示
        progress = (i - 1) / total
        filledBars = Int(barLength * progress)
        progressBar = String(filledBars, "■") & String(barLength - filledBars, "□")
        Application.StatusBar = "(" & (i - 1) & "/" & total & ") " & progressBar & " 処理中..."

        ' =============================
        ' ステータスバーが確認できるようテスト用に0.2秒待機（ミリ秒単位）。
        ' 実際に使用する際は以下２行不要。
        ' =============================
        DoEvents
        Sleep 200
        ' =============================

        GoTo ContinueLoop

ErrorHandler:
        ' エラー時はログに出力
        errorMsg = "行 " & i & " でエラー: " & Err.Description
        Print #1, errorMsg
        Err.Clear

ContinueLoop:
        DoEvents
    Next i

    ' 後処理：ログファイルを閉じ、ステータスバーを元に戻す
    Close #1
    Application.StatusBar = False

    ' 処理完了のメッセージを表示
    MsgBox "処理が完了しました。" & vbCrLf & _
           "エラーログ: " & logPath, vbInformation
End Sub

補足

実際にサンプルコードを応用して作成する際は以下に注意する。

・ 「ステータスバーが確認できるようテスト用に0.2秒待機（ミリ秒単位）。」と記載されいている箇所は進捗バーを表示するために使ったので不要です。

・ 「任意の処理」と記載されている箇所は自身が行いたい処理を入れてください。

最後に

最後にマクロの実行手順を載せておきます。

マクロの実行手順

１．エクセルを起動し、「開発」タブを開きます。（開発タブがない場合は、「ファイル」→「オプション」→「リボンのユーザー設定」→開発にチェックを入れる)

２．「コード」箇所の「Visual Basic」をクリック。

３．VBEが表示されたら、「挿入」タブの標準モジュールをクリックしてください。

４．作成された標準モジュールにコードを張り付ける。

５．コードの貼り付け及び保存完了後、以下画面の開発タブに移動し、「コード」箇所の「マクロ」をクリック。

６．実行したいマクロを選択し、「実行」ボタンをクリックする。
　　※「開発」タブ→「コントロール」→「挿入」からボタンを追加し、ボタンにマクロを登録することも可能である。