生成AIと100本ノック 29本目：画像の挿入

公開日：2025-06-13　最終更新日：2025-06-13

生成AIと100本ノック 29本目：画像の挿入

AIのGeminiがVBA100本ノックに挑戦！
ということでシリーズを開始しましたが、ある程度回もすすんだので、検証方法を変更することにしました。

独自に作成した、VBA開発の汎用プロンプト（命名：AI神髄VBA）が、他のお題で確認している範囲内では、かなり良い成果を出せています。
そこで、このプロンプトのさらなる改善と最終検証を目的として、100本ノックを進めていくことにします。

以下の代表的な生成AI3つで確認を進めます。

🤖 Gemini（2.5 Pro）（課金済の有料版）
🤖 ChatGPT（GPT-3.5）（無課金の無料版）
🤖 Claude（Sonnet4）（無課金の無料版）

VBA100本ノックの出題と解答

VBA100本ノック 29本目：画像の挿入

・出題・頂いた回答・解説・補足・サイト内関連ページ

生成AIへの出題

【VBAを作成】
ファイル選択ダイアログで画像ファイルを指定し、その画像をアクティブセルにリンクしない図として貼り付けてください。
貼り付けた画像は、縦横比を維持したままセル内に収めてください。
セル内の位置はなるべく真ん中に。
※選択できる拡張子は適当に。

-------------------- ここから共通プロンプト --------------------

ここから下に、「AI神髄VBA」の共通プロンプトが続きます。

Geminiの回答

はい、承知いたしました。
ファイル選択ダイアログで指定した画像を、アクティブセルにリンクせずに貼り付け、縦横比を維持したままセル内の中央に配置するVBAコードを、ご指定の要件に従って作成します。

VBAコード


  
    
      Option Explicit


'================================================================================

' メインモジュール

'================================================================================


'-----------------------------------------

' 機能: 全体的な処理フローを制御し、アクティブセルに画像ファイルを挿入する

' 引数: なし

' 戻り値: なし

' 備考: 処理の開始と終了時にアプリケーション設定を制御します。

'-----------------------------------------

Public Sub Main_InsertPictureToCell()

　　'--- 高速化設定 ---

　　With Application

　　　　.ScreenUpdating = False

　　　　.Calculation = xlCalculationManual

　　　　.EnableEvents = False

　　　　.DisplayAlerts = False

　　End With


　　On Error GoTo ErrorHandler


　　'--- 事前チェック ---

　　' アクティブなものがセル(Range)であるかを確認

　　If TypeName(Selection) <> "Range" Then

　　　　MsgBox "処理を実行する前に、画像を挿入したいセルを選択してください。", vbExclamation

　　　　GoTo ExitHandler

　　End If

　　' 選択されているセルが単一であるかを確認

　　If Selection.Cells.CountLarge > 1 Then

　　　　MsgBox "画像を挿入できるのは単一のセルのみです。一つのセルを選択してください。", vbExclamation

　　　　GoTo ExitHandler

　　End If


　　Dim rngTarget As Range

　　Set rngTarget = ActiveCell


　　'--- 画像ファイル選択 ---

　　Dim strPicPath As String

　　strPicPath = GetPicturePath()

　　If strPicPath = "" Then GoTo ExitHandler ' キャンセル時は処理を中断


　　'--- 画像挿入と調整 ---

　　Call InsertAndAdjustPicture(rngTarget, strPicPath)


　　MsgBox "画像の挿入が完了しました。", vbInformation


ExitHandler:

　　'--- 高速化設定を元に戻す ---

　　With Application

　　　　.ScreenUpdating = True

　　　　.Calculation = xlCalculationAutomatic

　　　　.EnableEvents = True

　　　　.DisplayAlerts = True

　　End With

　　Set rngTarget = Nothing

　　Exit Sub


ErrorHandler:

　　MsgBox "予期せぬエラーが発生しました。" & vbCrLf & vbCrLf & _

　　　　　 "エラー箇所: Main_InsertPictureToCell" & vbCrLf & _

　　　　　 "エラー番号: " & Err.Number & vbCrLf & _

　　　　　 "エラー内容: " & Err.Description, vbCritical

　　Resume ExitHandler

End Sub



'================================================================================

' データ加工・ロジック / 出力・書き込み プロシージャー

'================================================================================


'-----------------------------------------

' 機能: 指定されたセルに画像を挿入し、セルのサイズに合わせて中央に配置する

' 引数: rngTarget (Range) - 画像を挿入する対象のセル

'　　　 strPicPath (String) - 画像ファイルのフルパス

' 戻り値: なし

' 備考: 画像はリンクせず、ドキュメントに埋め込まれます。

'　　　 縦横比は維持され、画像がセルより小さい場合は拡大されません。

'-----------------------------------------

Private Sub InsertAndAdjustPicture(ByVal rngTarget As Range, ByVal strPicPath As String)

　　Dim shp As Object 'As Shape

　　On Error GoTo ErrorHandler


　　' 画像をシートに挿入 (元のサイズで一旦挿入)

　　Set shp = rngTarget.Parent.Shapes.AddPicture( _

　　　　Filename:=strPicPath, _

　　　　LinkToFile:=False, _

　　　　SaveWithDocument:=True, _

　　　　Left:=rngTarget.Left, _

　　　　Top:=rngTarget.Top, _

　　　　Width:=-1, _

　　　　Height:=-1) ' -1は元のサイズを指定


　　With shp

　　　　' 縦横比を固定

　　　　.LockAspectRatio = msoTrue


　　　　'--- セル内に収まるようにサイズ調整 ---

　　　　Dim dblCellWidth As Double

　　　　Dim dblCellHeight As Double

　　　　dblCellWidth = rngTarget.Width

　　　　dblCellHeight = rngTarget.Height


　　　　' 画像がセルの幅または高さを超えている場合のみリサイズ

　　　　If .Width > dblCellWidth Or .Height > dblCellHeight Then

　　　　　　Dim dblRatioW As Double

　　　　　　Dim dblRatioH As Double

　　　　　　dblRatioW = dblCellWidth / .Width

　　　　　　dblRatioH = dblCellHeight / .Height


　　　　　　' より縮小率が大きい方(値が小さい方)に合わせてリサイズ

　　　　　　If dblRatioW < dblRatioH Then

　　　　　　　　.Width = dblCellWidth ' 幅をセルに合わせる(高さは縦横比固定で自動調整)

　　　　　　Else

　　　　　　　　.Height = dblCellHeight ' 高さをセルに合わせる(幅は縦横比固定で自動調整)

　　　　　　End If

　　　　End If


　　　　'--- 中央に配置 ---

　　　　.Left = rngTarget.Left + (dblCellWidth - .Width) / 2

　　　　.Top = rngTarget.Top + (dblCellHeight - .Height) / 2

　　End With


　　Set shp = Nothing

　　Exit Sub


ErrorHandler:

　　' エラーが発生した場合、作成された可能性のあるShapeオブジェクトを削除

　　If Not shp Is Nothing Then

　　　　On Error Resume Next ' Deleteでエラーが出ても無視

　　　　shp.Delete

　　　　On Error GoTo 0

　　End If

　　' エラーを呼び出し元に伝播させる

　　Err.Raise Err.Number, "InsertAndAdjustPicture", Err.Description

End Sub



'================================================================================

' ユーティリティ プロシージャー

'================================================================================


'-----------------------------------------

' 機能: ファイル選択ダイアログを表示し、ユーザーに画像ファイルを選択させる

' 引数: なし

' 戻り値: String - 選択された画像ファイルのフルパス。キャンセルの場合は空文字列。

' 備考: 一般的な画像形式をフィルタリングします。

'-----------------------------------------

Private Function GetPicturePath() As String

　　Dim fd As Object 'Office.FileDialog

　　Set fd = Application.FileDialog(msoFileDialogFilePicker)


　　With fd

　　　　.Title = "画像ファイルを選択してください"

　　　　.AllowMultiSelect = False

　　　　.Filters.Clear

　　　　.Filters.Add "画像ファイル", "*.jpg; *.jpeg; *.png; *.gif; *.bmp", 1

　　　　.Filters.Add "JPEG ファイル (*.jpg, *.jpeg)", "*.jpg; *.jpeg", 2

　　　　.Filters.Add "PNG ファイル (*.png)", "*.png", 3

　　　　.Filters.Add "GIF ファイル (*.gif)", "*.gif", 4

　　　　.Filters.Add "BMP ファイル (*.bmp)", "*.bmp", 5

　　　　.Filters.Add "すべてのファイル (*.*)", "*.*", 6

　　　　.FilterIndex = 1 ' 初期表示は「画像ファイル」


　　　　' ダイアログを表示し、ファイルが選択されたか確認

　　　　If .Show = -1 Then 'OKボタンが押された場合 (True)

　　　　　　GetPicturePath = .SelectedItems(1)

　　　　Else 'キャンセルボタンが押された場合 (False)

　　　　　　GetPicturePath = ""

　　　　End If

　　End With


　　Set fd = Nothing

End Function

VBAコードの解説

1. 概要
このVBAコードは、ユーザーがファイル選択ダイアログを通じて選んだ画像ファイルを、Excelのアクティブセル内に自動でサイズ調整して中央に配置する機能を提供します。画像はファイルへのリンクではなく、Excelファイル自体に埋め込まれるため、元の画像ファイルを移動・削除しても表示が維持されます。
2. 主な機能と特徴
- 対話的なファイル選択: FileDialog オブジェクトを使用し、ユーザーが直感的に画像ファイルを選択できます。
- 画像の自動調整: 選択された画像を、指定されたセルのサイズに合わせて縦横比を維持したままリサイズし、セルの中央に配置します。画像がセルより小さい場合は、拡大されません。
- 堅牢な設計:
  - エラーハンドリング: 処理中に予期せぬエラーが発生しても、アプリケーションを安定した状態に保ち、ユーザーに分かりやすいメッセージを表示します。
  - 高速化処理: 画像挿入処理中の画面描画やイベント発生を一時的に停止し、スムーズな動作を実現します。
- 高保守性: 機能ごとにプロシージャを分割（メイン処理、画像挿入・調整、ファイルパス取得）しており、コードの可読性が高く、将来の修正や機能追加が容易です。
3. ご利用方法
1. ExcelのVBE（Visual Basic Editor）を開きます (Alt + F11)。
2. 「挿入」メニューから「標準モジュール」を選択します。
3. 上記VBAコードをコピーして、表示されたモジュールウィンドウに貼り付けます。
4. Excelシートに戻り、画像を挿入したいセルを一つだけ選択します。
5. Alt + F8 を押してマクロダイアログを開き、Main_InsertPictureToCell を選択して「実行」ボタンを押します。
6. ファイル選択ダイアログが表示されるので、目的の画像ファイルを選択して「開く」をクリックします。
4. 各プロシージャの解説
- Main_InsertPictureToCell (メインプロシージャ)
  全体の処理の流れを制御します。
  - 高速化設定: 処理の開始時に画面更新などを停止し、終了時に元に戻します。
  - 事前チェック: ユーザーが単一のセルを選択しているかを確認し、不適切な場合はメッセージを表示して処理を中断します。
  - プロシージャ呼び出し: GetPicturePath を呼び出して画像のパスを取得し、InsertAndAdjustPicture を呼び出して画像の挿入と調整を実行します。
  - エラーハンドリング: On Error GoTo を使用して、モジュール全体で発生した予期せぬエラーを捕捉し、ユーザーに通知します。
- InsertAndAdjustPicture (画像挿入・調整プロシージャ)
  実際に画像を挿入し、調整する中核部分です。
  - 画像挿入: Shapes.AddPicture メソッドを使用して、画像をシートに追加します。この際、LinkToFile:=False, SaveWithDocument:=True を指定することで、画像をExcelファイルに埋め込みます。
  - サイズ調整: LockAspectRatio = msoTrue で画像の縦横比を固定した後、セルの大きさと画像の大きさを比較します。画像がセルより大きい場合、セルの幅か高さのどちらか小さい方の比率に合わせて画像を縮小します。
  - 中央配置: 画像の Left プロパティと Top プロパティを計算し、セルの中央に配置されるように調整します。
  - エラー伝播: このプロシージャ内でエラーが発生した場合、作成途中の画像を削除した後、Err.Raise を使ってエラー情報を呼び出し元の Main_InsertPictureToCell に伝播させます。
- GetPicturePath (ファイルパス取得関数)
  Application.FileDialog を使用してファイル選択ダイアログを表示し、ユーザーが選択したファイルのパスを取得するユーティリティ関数です。
  - フィルタ設定: Filters.Add を用いて、JPEG, PNG, GIF, BMPといった一般的な画像形式を絞り込み候補として表示します。
  - 戻り値: ユーザーがファイルを選択して「開く」を押した場合はそのファイルのフルパスを返します。「キャンセル」が押された場合は空文字列 ("") を返し、メインプロシージャはこれを受け取って処理を安全に中断します。

VBAは問題ないですね。
説明も丁寧です。

ChatGPTの回答

以下に、画像ファイルを選択してアクティブセルに縦横比を保って中央に収まるように非リンクで貼り付けるVBAコードを、「高凝集・低結合」「堅牢性・保守性・高速性」を満たす構造で提示します。

VBAコード


  
    
      Option Explicit


      '-----------------------------------------

      ' 機能: メイン処理（画像貼り付け処理の統括とエラーハンドリング）

      ' 引数: なし

      ' 戻り値: なし

      ' 備考: 設定変更と復元を含む

      '-----------------------------------------

      Public Sub InsertImageIntoActiveCell()

      　　

      　　Dim blnSuccess As Boolean

      　　Dim lngCalcState As XlCalculation

      　　Dim blnEventsState As Boolean

      　　Dim blnDisplayAlertsState As Boolean

      　　Dim blnScreenUpdatingState As Boolean


      　　On Error GoTo ErrorHandler


      　　' 高速化設定保存

      　　lngCalcState = Application.Calculation

      　　blnEventsState = Application.EnableEvents

      　　blnDisplayAlertsState = Application.DisplayAlerts

      　　blnScreenUpdatingState = Application.ScreenUpdating


      　　' 高速化設定

      　　Application.ScreenUpdating = False

      　　Application.Calculation = xlCalculationManual

      　　Application.EnableEvents = False

      　　Application.DisplayAlerts = False


      　　' 初期化処理（画像ファイル選択）

      　　Dim strImagePath As String

      　　strImagePath = SelectImageFile()

      　　If strImagePath = "" Then Exit Sub


      　　' 出力処理（画像貼り付け）

      　　blnSuccess = InsertAndResizeImage(strImagePath, ActiveCell)


      　　If Not blnSuccess Then

      　　　　MsgBox "画像の貼り付けに失敗しました。", vbExclamation

      　　End If


      Cleanup:

      　　' 設定を元に戻す

      　　Application.Calculation = lngCalcState

      　　Application.EnableEvents = blnEventsState

      　　Application.DisplayAlerts = blnDisplayAlertsState

      　　Application.ScreenUpdating = blnScreenUpdatingState

      　　Exit Sub


      ErrorHandler:

      　　MsgBox "エラーが発生しました。" & vbCrLf & _

      　　　　　 "番号: " & Err.Number & vbCrLf & _

      　　　　　 "内容: " & Err.Description & vbCrLf & _

      　　　　　 "プロシージャ: InsertImageIntoActiveCell", vbCritical

      　　Resume Cleanup


      End Sub


      '-----------------------------------------

      ' 機能: ファイル選択ダイアログで画像ファイルを選択

      ' 引数: なし

      ' 戻り値: String - 選択された画像ファイルのフルパス、未選択の場合は空文字

      ' 備考: 拡張子はjpg, png, bmp, gifに対応

      '-----------------------------------------

      Private Function SelectImageFile() As String

      　　Dim strFilePath As String

      　　With Application.FileDialog(msoFileDialogFilePicker)

      　　　　.Title = "画像ファイルを選択してください"

      　　　　.Filters.Clear

      　　　　.Filters.Add "画像ファイル", "*.jpg;*.jpeg;*.png;*.bmp;*.gif"

      　　　　.AllowMultiSelect = False

      　　　　If .Show = -1 Then

      　　　　　　strFilePath = .SelectedItems(1)

      　　　　End If

      　　End With

      　　SelectImageFile = strFilePath

      End Function


      '-----------------------------------------

      ' 機能: 指定セルに画像を縦横比を保ち中央配置で貼り付け

      ' 引数: strImagePath (String) - 画像ファイルパス

      ' 　　　rngTarget (Range) - 画像を貼り付けるセル

      ' 戻り値: Boolean - 貼り付け成功時 True

      ' 備考: 図として貼り付け、リンクしない

      '-----------------------------------------

      Private Function InsertAndResizeImage(ByVal strImagePath As String, ByVal rngTarget As Range) As Boolean

      　　On Error GoTo ErrorHandler


      　　Dim shp As Shape

      　　Dim ws As Worksheet

      　　Dim dblCellLeft As Double, dblCellTop As Double

      　　Dim dblCellWidth As Double, dblCellHeight As Double

      　　Dim dblImageWidth As Double, dblImageHeight As Double

      　　Dim dblScale As Double


      　　Set ws = rngTarget.Worksheet


      　　' 画像を挿入（リンクなしの図として）

      　　Set shp = ws.Shapes.AddPicture( _

      　　　　　　　　Filename:=strImagePath, _

      　　　　　　　　LinkToFile:=msoFalse, _

      　　　　　　　　SaveWithDocument:=msoCTrue, _

      　　　　　　　　Left:=0, Top:=0, Width:=-1, Height:=-1)


      　　' 対象セルのサイズ取得

      　　dblCellLeft = rngTarget.Left

      　　dblCellTop = rngTarget.Top

      　　dblCellWidth = rngTarget.Width

      　　dblCellHeight = rngTarget.Height


      　　' 画像の元サイズを取得

      　　dblImageWidth = shp.Width

      　　dblImageHeight = shp.Height


      　　' 縦横比を維持してセル内に収めるためのスケール計算

      　　dblScale = WorksheetFunction.Min(dblCellWidth / dblImageWidth, dblCellHeight / dblImageHeight)


      　　shp.LockAspectRatio = msoTrue

      　　shp.Width = dblImageWidth * dblScale

      　　shp.Height = dblImageHeight * dblScale


      　　' セルの中央に配置

      　　shp.Left = dblCellLeft + (dblCellWidth - shp.Width) / 2

      　　shp.Top = dblCellTop + (dblCellHeight - shp.Height) / 2


      　　InsertAndResizeImage = True

      　　Exit Function


      ErrorHandler:

      　　InsertAndResizeImage = False

      End Function

コードの解説
全体構成（5分割）

種別	プロシージャ名	役割
メイン	InsertImageIntoActiveCell	全体制御・高速化設定・エラー処理
初期化	SelectImageFile	画像ファイルの選択ダイアログ表示
出力処理	InsertAndResizeImage	非リンクで画像挿入＋サイズ調整＋中央配置
ユーティリティ	-	関数内に吸収（汎用化不要と判断）
データ加工	-	該当なし（本件では不要）

技術的ポイント

非リンク画像挿入：Shapes.AddPicture(..., LinkToFile:=msoFalse) を使用。
セル内中央配置・縦横比維持：スケール比計算し、LockAspectRatio + 手動配置で実現。
高速化対応：Application.ScreenUpdating など4項目を保存／復元。
堅牢性：すべてのプロシージャで On Error によるハンドリング実装。
再利用性と保守性：画像処理ロジックを独立関数化、ファイル選択UIを分離。

ご希望があれば以下のような改良も可能です：

アクティブセルが結合セルかどうかの検出と考慮
図形名の自動命名や管理
複数画像の一括挿入（複数選択対応）
セルサイズを画像サイズに合わせて自動調整など
必要があればお申し付けください。

VBAは良いですね。
説明はいつもながら簡潔です。ちょっと物足りないですが(笑)

Claudeの回答

指定された要件に基づいて、画像ファイルを選択してアクティブセルに貼り付けるVBAコードを作成します。


  
    
      Option Explicit


'-----------------------------------------

' 機能: 画像ファイルを選択してアクティブセルに貼り付ける（メイン処理）

' 引数: なし

' 戻り値: なし

' 備考: 高速化設定を適用し、エラーハンドリングを実装

'-----------------------------------------

Sub InsertImageToActiveCell()

　　Dim strFilePath As String

　　Dim rngTargetCell As Range

　　Dim objShape As Object

　　Dim dblCellWidth As Double

　　Dim dblCellHeight As Double

　　

　　' 高速化設定を適用

　　Call EnableFastProcessing

　　

　　On Error GoTo ErrorHandler

　　

　　' 画像ファイルを選択

　　strFilePath = SelectImageFile()

　　If strFilePath = "" Then

　　　　GoTo ExitHandler

　　End If

　　

　　' アクティブセルを取得

　　Set rngTargetCell = ActiveCell

　　

　　' セルの寸法を取得

　　Call GetCellDimensions(rngTargetCell, dblCellWidth, dblCellHeight)

　　

　　' 画像を挿入

　　Set objShape = InsertImageAsShape(strFilePath, rngTargetCell)

　　

　　' 画像をセル内に配置・調整

　　Call AdjustImageToFitCell(objShape, rngTargetCell, dblCellWidth, dblCellHeight)

　　

　　GoTo ExitHandler

　　

ErrorHandler:

　　Call HandleError("InsertImageToActiveCell", Err.Number, Err.Description)

　　

ExitHandler:

　　' 設定を復元

　　Call RestoreOriginalSettings

End Sub


'-----------------------------------------

' 機能: 画像ファイル選択ダイアログを表示

' 引数: なし

' 戻り値: String - 選択されたファイルパス（キャンセル時は空文字）

' 備考: 画像ファイルのみ選択可能

'-----------------------------------------

Private Function SelectImageFile() As String

　　Dim varResult As Variant

　　

　　On Error GoTo ErrorHandler

　　

　　' ファイル選択ダイアログを表示

　　varResult = Application.GetOpenFilename( _

　　　　"画像ファイル (*.jpg;*.jpeg;*.png;*.gif;*.bmp;*.tiff;*.tif),*.jpg;*.jpeg;*.png;*.gif;*.bmp;*.tiff;*.tif," & _

　　　　"JPEG (*.jpg;*.jpeg),*.jpg;*.jpeg," & _

　　　　"PNG (*.png),*.png," & _

　　　　"GIF (*.gif),*.gif," & _

　　　　"BMP (*.bmp),*.bmp," & _

　　　　"TIFF (*.tiff;*.tif),*.tiff;*.tif", _

　　　　, "画像ファイルを選択してください")

　　

　　If varResult <> False Then

　　　　SelectImageFile = CStr(varResult)

　　Else

　　　　SelectImageFile = ""

　　End If

　　

　　Exit Function

　　

ErrorHandler:

　　SelectImageFile = ""

　　Call HandleError("SelectImageFile", Err.Number, Err.Description)

End Function


'-----------------------------------------

' 機能: セルの幅と高さを取得

' 引数: rngCell (Range) - 対象セル

'　　　 dblWidth (Double) - セル幅（参照渡し）

'　　　 dblHeight (Double) - セル高さ（参照渡し）

' 戻り値: なし

' 備考: ポイント単位で取得

'-----------------------------------------

Private Sub GetCellDimensions(ByRef rngCell As Range, ByRef dblWidth As Double, ByRef dblHeight As Double)

　　On Error GoTo ErrorHandler

　　

　　dblWidth = rngCell.Width

　　dblHeight = rngCell.Height

　　

　　Exit Sub

　　

ErrorHandler:

　　' デフォルト値を設定

　　dblWidth = 100

　　dblHeight = 20

　　Call HandleError("GetCellDimensions", Err.Number, Err.Description)

End Sub


'-----------------------------------------

' 機能: 画像ファイルをShapeオブジェクトとして挿入

' 引数: strFilePath (String) - 画像ファイルパス

'　　　 rngCell (Range) - 挿入対象セル

' 戻り値: Object - 挿入されたShapeオブジェクト

' 備考: リンクなしで挿入

'-----------------------------------------

Private Function InsertImageAsShape(ByVal strFilePath As String, ByRef rngCell As Range) As Object

　　Dim objShape As Object

　　

　　On Error GoTo ErrorHandler

　　

　　' 画像をShapeオブジェクトとして挿入（リンクなし）

　　Set objShape = rngCell.Worksheet.Shapes.AddPicture( _

　　　　Filename:=strFilePath, _

　　　　LinkToFile:=False, _

　　　　SaveWithDocument:=True, _

　　　　Left:=rngCell.Left, _

　　　　Top:=rngCell.Top, _

　　　　Width:=-1, _

　　　　Height:=-1)

　　

　　Set InsertImageAsShape = objShape

　　

　　Exit Function

　　

ErrorHandler:

　　Set InsertImageAsShape = Nothing

　　Call HandleError("InsertImageAsShape", Err.Number, Err.Description & " ファイル: " & strFilePath)

End Function


'-----------------------------------------

' 機能: 画像をセル内に収まるように調整・配置

' 引数: objShape (Object) - 調整対象のShapeオブジェクト

'　　　 rngCell (Range) - 配置対象セル

'　　　 dblCellWidth (Double) - セル幅

'　　　 dblCellHeight (Double) - セル高さ

' 戻り値: なし

' 備考: 縦横比を維持してセル中央に配置

'-----------------------------------------

Private Sub AdjustImageToFitCell(ByRef objShape As Object, ByRef rngCell As Range, _

　　　　　　　　　　　　　　　　ByVal dblCellWidth As Double, ByVal dblCellHeight As Double)

　　Dim dblImageWidth As Double

　　Dim dblImageHeight As Double

　　Dim dblScaleRatio As Double

　　Dim dblNewWidth As Double

　　Dim dblNewHeight As Double

　　Dim dblOffsetX As Double

　　Dim dblOffsetY As Double

　　

　　On Error GoTo ErrorHandler

　　

　　If objShape Is Nothing Then Exit Sub

　　

　　' 元の画像サイズを取得

　　dblImageWidth = objShape.Width

　　dblImageHeight = objShape.Height

　　

　　' 縦横比を維持しながらセル内に収まるスケール比を計算

　　dblScaleRatio = Application.WorksheetFunction.Min(dblCellWidth / dblImageWidth, dblCellHeight / dblImageHeight)

　　

　　' 新しいサイズを計算

　　dblNewWidth = dblImageWidth * dblScaleRatio

　　dblNewHeight = dblImageHeight * dblScaleRatio

　　

　　' セル中央に配置するためのオフセットを計算

　　dblOffsetX = (dblCellWidth - dblNewWidth) / 2

　　dblOffsetY = (dblCellHeight - dblNewHeight) / 2

　　

　　' 画像のサイズと位置を設定

　　With objShape

　　　　.Width = dblNewWidth

　　　　.Height = dblNewHeight

　　　　.Left = rngCell.Left + dblOffsetX

　　　　.Top = rngCell.Top + dblOffsetY

　　End With

　　

　　Exit Sub

　　

ErrorHandler:

　　Call HandleError("AdjustImageToFitCell", Err.Number, Err.Description)

End Sub


'-----------------------------------------

' 機能: 高速化設定を適用

' 引数: なし

' 戻り値: なし

' 備考: 処理速度向上のため各種設定を無効化

'-----------------------------------------

Private Sub EnableFastProcessing()

　　On Error Resume Next

　　

　　Application.ScreenUpdating = False

　　Application.Calculation = xlCalculationManual

　　Application.EnableEvents = False

　　Application.DisplayAlerts = False

　　

　　On Error GoTo 0

End Sub


'-----------------------------------------

' 機能: 元の設定を復元

' 引数: なし

' 戻り値: なし

' 備考: 高速化設定を元に戻す

'-----------------------------------------

Private Sub RestoreOriginalSettings()

　　On Error Resume Next

　　

　　Application.ScreenUpdating = True

　　Application.Calculation = xlCalculationAutomatic

　　Application.EnableEvents = True

　　Application.DisplayAlerts = True

　　

　　On Error GoTo 0

End Sub


'-----------------------------------------

' 機能: エラーハンドリング処理

' 引数: strProcedureName (String) - エラー発生プロシージャ名

'　　　 lngErrorNumber (Long) - エラー番号

'　　　 strErrorDescription (String) - エラー内容

' 戻り値: なし

' 備考: ユーザーにエラー情報を表示

'-----------------------------------------

Private Sub HandleError(ByVal strProcedureName As String, ByVal lngErrorNumber As Long, ByVal strErrorDescription As String)

　　Dim strMessage As String

　　

　　strMessage = "エラーが発生しました。" & vbCrLf & vbCrLf & _

　　　　　　　　"プロシージャ: " & strProcedureName & vbCrLf & _

　　　　　　　　"エラー番号: " & lngErrorNumber & vbCrLf & _

　　　　　　　　"エラー内容: " & strErrorDescription

　　

　　MsgBox strMessage, vbCritical, "エラー"

End Sub

VBAコードの解説
作成したVBAコードは、以下の機能を持つ業務品質レベルの自動化コードです：
主要機能

ファイル選択ダイアログ：画像ファイル（JPG、PNG、GIF、BMP、TIFF）を選択可能
リンクなし貼り付け：選択した画像をリンクしない図としてアクティブセルに挿入
縦横比維持：画像の元の縦横比を保持したままセル内に収める
中央配置：画像をセル内の中央に配置

プロシージャー構成

InsertImageToActiveCell：メインプロシージャー、全体的な処理フローを制御
SelectImageFile：ファイル選択ダイアログの表示と結果取得
GetCellDimensions：セルの幅と高さの取得
InsertImageAsShape：画像ファイルをShapeオブジェクトとして挿入
AdjustImageToFitCell：画像のサイズ調整と位置設定
EnableFastProcessing / RestoreOriginalSettings：高速化設定の適用と復元
HandleError：統一されたエラーハンドリング

設計上の特徴

高凝集・低結合：各プロシージャーが単一の責任を持ち、独立性が保たれています
堅牢なエラーハンドリング：各プロシージャーでエラーを適切にキャッチし、ユーザーに分かりやすいメッセージを表示
高速化処理：処理開始時に画面更新等を無効化し、終了時に復元
保守性：意味のある名前付け、適切なコメント、明確なコード構造

使用方法

VBAエディターで標準モジュールに貼り付け
InsertImageToActiveCellプロシージャーを実行
ファイル選択ダイアログで画像ファイルを選択
選択した画像がアクティブセルに縦横比を維持したまま中央配置で挿入されます

このコードは業務利用に適した品質で、エラー処理、高速化、保守性を兼ね備えています。

VBAはもちろん良いです。
説明も適切で読みやすいと思います。

同じテーマ「生成AI活用研究」の記事

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.変数宣言のDimとデータ型｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.FILTER関数（範囲をフィルター処理）｜エクセル入門
7.メッセージボックス(MsgBox関数)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
10.マクロとは？VBAとは？VBAでできること｜VBA入門

ホーム
その他
生成AI活用研究
生成AIと100本ノック 29本目：画像の挿入

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

生成AI活用研究
生成AIと100本ノック 29本目：画像の挿入