この機能はマクロVBAでも設定・変更が可能です。

今回は図形の枠に色を付ける方法について紹介しています。
様々な方法を紹介していますので是非参考にしてみてください。

図形の塗りつぶしについてはこちらから☟

【マクロVBA】図形の塗りつぶし・色の設定方法！ Fill.ForeColorとRGB等の使い方 ► 独学エクセル塾 (dokugakuexcel.com)

それでは見ていきましょう。

⬛︎忙しい人向けのコピペ用プログラム

Sub 変数を応用して図の枠に色をRGBでつける()
Dim Target, Red As Long, Green As Long, Blue As Long
Red = 115 '任意のRの数値を入力
Green = 55 '任意のGの数値を入力
Blue = 100 '任意のBの数値を入力
Target = Selection.Name
ActiveSheet.Shapes(Target).Line.ForeColor.RGB = RGB(Red, Green, Blue)
End Sub

⬛︎構文

今回は３パターン紹介しています。
使用方法は後ほど紹介しています。

①RGBで図形の枠に色を付ける方法
Activesheet.Shapes (“ここに図形の名前”).Line.ForeColor.RGB = RGB(Rの数値,Gの数値,Bの数値)

②SchemeColorで図形の枠に色を付ける方法
Activesheet.Shapes (“ここに図形の名前”).Line.ForeColor.SchemeColor = ここに1から80の数値

③ObjectThemeColorで図形の枠に色を付ける方法
Activesheet.Shapes (“ここに図形の名前”).Line.ForeColor.ObjectThemeColor =テーマの配色の名前または値

　
※配色については下記表を参照してください。

⬛︎図の枠に色を付けるをする

先程は３つの構文を紹介しました。
それでは実際にそれぞれの使用方法を紹介します。

①RGBで図形の枠に色を付ける方法

まずはRGBで図形の枠に色を付ける方法について見ていきましょう。
RGBとは「RED:赤」「Green:緑」「Blue:青」の原色を意味しており、
この3色を混ぜて色を指定します。

各数値は「0から255」で指定します。
では構文を再度確認しましょう。

Activesheet.Shapes (“ここに図形の名前”).Line.ForeColor.RGB = RGB(Rの数値,Gの数値,Bの数値)

Activesheet.Shapesの後に図形の名前を入力します。
図の名前は図を選択した際に左上の「名前のボックス」から確認することができます。

「変数= Selection.Name」で選択している図の名前を変数に格納して活用することも可能です。

一方、RGBの方はRGB(赤の要素,緑の要素,青の要素)のように指示します。

ちなみに各要素の数値が大きければ各原色は濃くなります。
一例を紹介すると下記の通りです。

白:RGB(0,0,0)
黒:RGB(255,255,255)
赤:RGB(255,0,0)
黄色:RGB(255,255,0)
青:RGB(0,0,255)

では実際にプログラムを作成してみましょう。
見本として下図のシートを用意しました。

今回は見本で「見本図」という名前をつけた図を用意しました。
こちらの図の枠に色を付けるてみたいと思います。

例で赤色の枠になるように色を付けてみましょう。
プログラムはこのようになります。

Sub 図の枠の色をRGBでつける()
ActiveSheet.Shapes("見本図").Line.ForeColor.RGB = RGB(255, 0, 0)
End Sub

それでは実行してみましょう。
結果はこのようになりました。

見本の図の枠の色を赤くすることができました。

選択している図の色を変更したい場合はこちらです。

Sub 図の枠の色をRGBでつける()
Dim Target As String
Target = Selection.Name
ActiveSheet.Shapes(Target).Line.ForeColor.RGB = RGB(255, 0, 0)
End Sub

②SchemeColorで図形の枠に色を付ける方法

次に「SchemeColor」で図形の枠に色を付ける方法を見ていきましょう。

では再度、構文を確認したいと思います。

Activesheet.Shapes (“ここに図形の名前”).Line.ForeColor.SchemeColor = ここに1から80の数値

こちらの方法は「ForeColor.SchemeColor」で枠に色を付けるを宣言し、「＝」の後に
「0から80」の数値を指定します。

では見本で「6」で実行してみましょう。

今回も下図の「見本図」の色を変えたいと思います。

プログラムはこちらです。

Sub 図の枠の色をSchemeColorでつける()
ActiveSheet.Shapes("見本図").Line.ForeColor.SchemeColor = 6
End Sub

それでは実行してみましょう。
結果はこのようになります。

「見本図」の枠の色が変わりました。

では「SchemeColor」の1から80の色はどのようなものか
下図の一覧で確認してみましょう。

一応確認用の図を表示させるプログラムを載せています。

Sub SchemeColorの色一覧()

Dim CycleR As Long, CycleC As Long, No As Long
Dim TargetLeft, TargetTop, TargetWidth, TargetHeight

No = 1
For CycleC = 1 To 10 Step 3
　For CycleR = 1 To 20 Step 1
　　TargetLeft = Cells(CycleR, CycleC).Left
　　TargetTop = Cells(CycleR, CycleC).Top
　　TargetWidth = Cells(CycleR, CycleC).Width
　　TargetHeight = Cells(CycleR, CycleC).Height
　　With ActiveSheet.Shapes.AddShape(msoShapeRectangle, TargetLeft, TargetTop, TargetWidth, TargetHeight)
　　.Line.ForeColor.SchemeColor = No
　　End With
　　Cells(CycleR, CycleC + 1) = ":" & No
　　No = No + 1
　Next CycleR
Next CycleC

End Sub

選択している図の色を変更したい場合はこちらです。

Sub 図の枠の色をSchemeColorでつける()
Dim Target As String
Target = Selection.Name
ActiveSheet.Shapes(Target).Line.ForeColor.SchemeColor = 10
End Sub

③ObjectThemeColorで図形の枠に色を付ける方法

こちらは設定しているテーマを活用した貼り付け方法になります。
テーマとは色を塗りつぶす際の初めに表示されるデフォルトの色になります。

つまり、こちらの方法で枠に色を付けた場合、「ページレイアウト」の「配色」の設定を変えると、その配色に合わせて色が変化します。
テーマに沿った枠の色を付けたい場合に使えそうですね。

では構文を見てみましょう。

Activesheet.Shapes (“ここに図形の名前”).Line.ForeColor.ObjectThemeColor = テーマの配色の名前または値

ここでの「テーマの配色」は「名前」または「値」が当てはまります。
一覧に関しては下記の表をご参照ください。

ちなみにテーマと値を比較すると下図のようになります。

では実際に図の枠に色を付けてみたいと思います。
今回も下図の「見本図」の色を変えたいと思います。

プログラムはこのようになります。

Sub 図の枠の色をObjectThemeColorでつける()
ActiveSheet.Shapes("見本図").Line.ForeColor.ObjectThemeColor = msoThemeColorAccent4
End Sub

今回は「msoThemeColorAccent4」としていますが「8」でも問題ありません。
実行した結果はこちらのです。

「見本図」の枠の色が変わりました。
先ほどの配色の表の通りに色が変化しましたね。

では見本で配色を変えてみましょう。
このようになります。

配色に合わせて図の色も変化しました。

選択している図の色を変更したい場合はこちらです。

Sub 図の枠の色をObjectThemeColorでつける()
Dim Target
Target = Selection.Name
ActiveSheet.Shapes(Target).Line.ForeColor.ObjectThemeColor = msoThemeColorAccent4
End Sub

⬛︎オススメの図の枠に色を付ける方法

これまで3つの方法で図の枠に色を付ける方法を紹介しましたが、
オススメを挙げるとすると「RGB」での指定になります。

理由としては下記の内容になります。

・色の調整や変更を計算や変数で応用できる
・RGBでの指定はどの条件でも変わらない（ObjectThemeColorは配色の設定で変わる）

例を見ていきます。
下記のプログラムを用意しました。

Sub 変数を応用して図の枠に色をRGBでつける()
Dim Target, Red As Long, Green As Long, Blue As Long
Red = 115 '任意のRの数値を入力
Green = 55 '任意のGの数値を入力
Blue = 100 '任意のBの数値を入力
Target = Selection.Name
ActiveSheet.Shapes(Target).Line.ForeColor.RGB = RGB(Red, Green, Blue)
End Sub

通常RGBの値を数値で入力していましたが、
見本のように変数を活用することができます。

⬛︎公式の説明

わかりやすいように説明したため公式と使用する語句が異なりますが
マイクロソフト公式の説明については下記のリンクを参照してください。☟

LineFormat.ForeColor プロパティ (Excel) | Microsoft Learn

⬛︎まとめ

いかがだったでしょうか。
VBAでも図の枠に色を付けることができるのは便利ですね。

是非参考にしてみてください。

それでは次回の記事でお会いしましょう。

この機能はマクロVBAでも設定・変更が可能です。

今回は図形を塗りつぶす方法について紹介しています。
様々な方法を紹介していますので是非参考にしてみてください。

図形の枠の色の変更方法についてはこちらから☟

【マクロVBA】図形の枠の色の設定・変更方法！ Line.ForeColorとRGB等の使い方 ► 独学エクセル塾 (dokugakuexcel.com)

それでは見ていきましょう。

⬛︎忙しい人向けのコピペ用プログラム

Sub 変数を応用して図に色をRGBで塗りつぶす()
Dim Target, Red As Long, Green As Long, Blue As Long
Red = 115 '任意のRの数値を入力
Green = 55 '任意のGの数値を入力
Blue = 100 '任意のBの数値を入力
Target = Selection.Name
ActiveSheet.Shapes(Target).Fill.ForeColor.RGB = RGB(Red, Green, Blue)
End Sub

⬛︎構文の説明

今回は３パターン紹介しています。
使用方法は後ほど紹介しています。

①RGBでの塗りつぶし
Activesheet.Shapes (“ここに図形の名前”).Fill.ForeColor.RGB = RGB(Rの数値,Gの数値,Bの数値)

②SchemeColorでの塗りつぶし
Activesheet.Shapes (“ここに図形の名前”).Fill.ForeColor.SchemeColor = ここに1から80の数値

③ObjectThemeColorでの塗りつぶし
Activesheet.Shapes (“ここに図形の名前”).Fill.ForeColor.ObjectThemeColor = テーマの配色の名前または値

　
※配色については下記表を参照してください。

⬛︎図の塗りつぶしをする

先程は３つの塗りつぶしの構文を紹介しました。
それでは実際にそれぞれの使用方法を紹介します。

①RGBでの塗りつぶし

まずはRGBで色をつける方法を見ていきましょう。
RGBとは「RED:赤」「Green:緑」「Blue:青」の原色を意味しており、
この3色を混ぜて色を指定します。

各数値は「0から255」で指定します。
では構文を再度確認しましょう。

Activesheet.Shapes (“ここに図形の名前”).Fill.ForeColor.RGB = RGB(Rの数値,Gの数値,Bの数値)

Activesheet.Shapesの後に図形の名前を入力します。
図の名前は図を選択した際に左上の「名前のボックス」から確認することができます。

「変数= Selection.Name」で選択している図の名前を変数に格納して活用することも可能です。

一方、RGBの方はRGB(赤の要素,緑の要素,青の要素)のように指示します。

ちなみに各要素の数値が大きければ各原色は濃くなります。
一例を紹介すると下記の通りです。

白:RGB(0,0,0)
黒:RGB(255,255,255)
赤:RGB(255,0,0)
黄色:RGB(255,255,0)
青:RGB(0,0,255)

では実際にプログラムを作成してみましょう。
見本として下図のシートを用意しました。

今回は見本で「見本図」という名前をつけた図を用意しました。
こちらを塗りつぶしてみたいと思います。

例で赤色に塗りつぶしてみましょう。
プログラムはこのようになります。

Sub 図に色をRGBで塗りつぶす()
ActiveSheet.Shapes("見本図").Fill.ForeColor.RGB = RGB(255, 0, 0)
End Sub

それでは実行してみましょう。
結果はこのようになりました。

見本図を赤く塗りつぶすことができましたね。

選択している図の色を変更したい場合はこちらです。

Sub 図に色をRGBで塗りつぶす()
Dim Target As String
Target = Selection.Name
ActiveSheet.Shapes(Target).Fill.ForeColor.RGB = RGB(255, 0, 0)
End Sub

②SchemeColorでの塗りつぶし

次に「SchemeColor」で塗りつぶす方法を見ていきましょう。

では再度、構文を確認したいと思います。

Activesheet.Shapes (“ここに図形の名前”).Fill.ForeColor.SchemeColor = ここに1から80の数値

こちらの方法は「ForeColor.SchemeColor」で塗りつぶしを宣言し、「＝」の後に
「0から80」の数値を指定します。

では見本で「6」で実行してみましょう。

今回も下図の「見本図」の色を変えたいと思います。

プログラムはこちらです。

Sub 図に色をSchemeColorで塗りつぶす()
ActiveSheet.Shapes("見本図").Fill.ForeColor.SchemeColor = 6
End Sub

それでは実行してみましょう。
結果はこのようになります。

「見本図」の色が変わりました。

では「SchemeColor」の1から80の色はどのようなものか
下図の一覧で確認してみましょう。

一応確認用の図を表示させるプログラムを載せています。

Sub SchemeColorの色一覧()

Dim CycleR As Long, CycleC As Long, No As Long
Dim TargetLeft, TargetTop, TargetWidth, TargetHeight

No = 1
For CycleC = 1 To 10 Step 3
 For CycleR = 1 To 20 Step 1
  TargetLeft = Cells(CycleR, CycleC).Left
  TargetTop = Cells(CycleR, CycleC).Top
  TargetWidth = Cells(CycleR, CycleC).Width
  TargetHeight = Cells(CycleR, CycleC).Height
  With ActiveSheet.Shapes.AddShape(msoShapeRectangle, TargetLeft, TargetTop, TargetWidth, TargetHeight)
        .Fill.ForeColor.SchemeColor = No
  End With
  Cells(CycleR, CycleC + 1) = ":" & No
  No = No + 1
 Next CycleR
Next CycleC

End Sub

選択している図の色を変更したい場合はこちらです。

Sub 図に色をSchemeColorで塗りつぶす1()
Dim Target As String
Target = Selection.Name
ActiveSheet.Shapes(Target).Fill.ForeColor.SchemeColor = 5
End Sub

③ObjectThemeColor

こちらは設定しているテーマを活用した貼り付け方法になります。
テーマとは色を塗りつぶす際の初めに表示されるデフォルトの色になります。

つまり、こちらの方法で塗りつぶした場合、「ページレイアウト」の「配色」の設定を変えると
その配色に合わせて色が変化します。
テーマに沿った塗りつぶしをしたい場合に使えそうですね。

では構文を見てみましょう。

Activesheet.Shapes (“ここに図形の名前”).Fill.ForeColor.ObjectThemeColor = テーマの配色の名前または値

ここでの「テーマの配色」は「名前」または「値」が当てはまります。
一覧に関しては下記の表をご参照ください。

ちなみにテーマと値を比較すると下図のようになります。

では実際に図を塗りつぶしてみたいと思います。
今回も下図の「見本図」の色を変えたいと思います。

Sub 図に色をObjectThemeColorで塗りつぶす()
ActiveSheet.Shapes("見本図").Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent3
End Sub

今回は「msoThemeColorAccent3」としていますが「7」でも問題ありません。
実行した結果はこちらのです。

「見本図」の色が変わりました。
先ほどの配色の表の通りに色が変化しましたね。

では見本で配色を変えてみましょう。
このようになります。

配色に合わせて図の色も変化しました。

選択している図の色を変更したい場合はこちらです。

Sub 図に色をObjectThemeColorで塗りつぶす()
Dim Target As String
Target = Selection.Name
ActiveSheet.Shapes(Target).Fill.ForeColor.ObjectThemeColor = 7
End Sub

⬛︎オススメの図に塗りつぶしをする方法

これまで3つの方法で図に塗りつぶしをする方法を紹介しましたが、
オススメを挙げるとすると「RGB」での指定になります。

理由としては下記の内容になります。

・色の調整や変更を計算や変数で応用できる
・RGBでの指定はどの条件でも変わらない（ObjectThemeColorは配色の設定で変わる）

例を見ていきます。
下記のプログラムを用意しました。

Sub 変数を応用して図に色をRGBで塗りつぶす()
Dim Target, Red As Long, Green As Long, Blue As Long
Red = 115 '任意のRの数値を入力
Green = 55 '任意のGの数値を入力
Blue = 100 '任意のBの数値を入力
Target = Selection.Name
ActiveSheet.Shapes(Target).Fill.ForeColor.RGB = RGB(Red, Green, Blue)
End Sub

通常RGBの値を数値で入力していましたが、
見本のように変数を活用することができます。

⬛︎公式の説明

わかりやすいように説明したため公式と使用する語句が異なりますが
マイクロソフト公式の説明については下記のリンクを参照してください。☟

FillFormat.ForeColor プロパティ (Excel) | Microsoft Learn

⬛︎まとめ

いかがだったでしょうか。
VBAでも図の塗りつぶしをできるのは便利ですね。

是非参考にしてみてください。

それでは次回の記事でお会いしましょう。

通常であれば、写真・図を貼り付けたい場合はコピーペーストして対応すると思いますが、
貼り付け位置が多い場合や、貼り付けのパターンが多ければコピペでの貼り付けは面倒です。

そこで今回はマクロVBAで変数・配列のように図を格納して好きな位置に

貼り付ける方法を紹介します。
是非参考にしてみてください。それではみていきましょう。

⬛︎忙しい人向けのコピぺ用プログラム

黄色の蛍光ペンの部分をお好みで打ち換えてください。

Sub 図を格納して貼り付け()

Dim WideValue, HighValue, PhotoName As String

For Each TARGET In ActiveSheet.Shapes '写真を繰り返し選択
　If Not Intersect(TARGET.TopLeftCell, Range("切り取り範囲")) Is Nothing And _
　　Not Intersect(TARGET.BottomRightCell, Range("切り取り範囲")) Is Nothing Then
　　　TARGET.Select False '指定範囲に入っていない写真は除外
　End If
Next TARGET

With Selection
　WideValue = .Width '幅を格納
　HighValue = .Height '高さを格納
　.Copy '対象をコピー
End With　

ActiveSheet.ChartObjects.Add(0, 0, WideValue, HighValue).Name = "Targerpicture" 'チャートの作成
ActiveSheet.ChartObjects("Targerpicture").Activate '作成したチャートをアクティブに
ActiveChart.Paste 'チャートに写真を貼り付ける
ActiveChart.ChartArea.Format.Line.Visible = msoFalse 'チャートの外枠をなくす

PhotoName = "保存するパス" & "\" & "貼り付け用写真.jpg"

With ActiveSheet.ChartObjects("Targerpicture")
　.Chart.Export PhotoName '写真を名前をつけて保存
　.Delete
End With

Set OBJSHAPE = ActiveSheet.Shapes.AddPicture( _
　　　　　　　　  FileName:=PhotoName, _
                          LinkToFile:=False, _
　　　　　　　　  SaveWithDocument:=True, _
　　　　　　　　  Left:=ActiveSheet.Range("貼り付け位置").Left, _
　　　　　　　　  Top:=ActiveSheet.Range("貼り付け位置").Top, _
　　　　　　　　  Width:=ActiveSheet.Range("貼り付けサイズ").Width, _
　　　　　　　　  Height:=ActiveSheet.Range("貼り付けサイズ").Height) '貼り付け

Kill PhotoName '写真を消す

End Sub

⬛︎プログラムの考え方について

まず結論から言うと配列や変数などに写真・図を格納することは不可能です。
しかし、似たような事をすることは出来ます。

様々な方法があるのかもしれませんが今回紹介する方法は
写真・図を一旦保存して、そのファイル名を変数に書き込み
その変数を用いて指定位置に貼り付けます。

なので手順としては

①指定範囲内にある写真・図を選択する
②写真・図を保存して、そのパスを変数に格納する
③指定位置に貼り付ける
④プログラム終了後は写真・図ファイルを削除する

と言った流れになります。
では実践編をみていきましょう。

⬛︎実践編:写真・図を格納して貼り付ける方法

では①から④の順に見ていきましょう。

・①指定範囲内にある写真・図を選択する

まずは格納したい写真・図を名前をつけて保存したいと思います。
注意点としてVBAで保存できるのは「Chart」となります。
「Chart」はグラフを意味します。

なのでイメージとして「Chart」を作成して
そこに指定した写真・図を貼り付けて写真・図ごと「Chart」を保存する
といった流れです。

ではまず、保存したい写真・図を選択します。
見本の写真は下図の通りです。

今回は指定範囲内にある写真・図を登録してみましょう。

構文はこちらです。

For Each TARGET In ActiveSheet.Shapes '写真を繰り返し選択

If Not Intersect(TARGET.TopLeftCell, Range("A1:D5")) Is Nothing And _
Not Intersect(TARGET.BottomRightCell, Range("A1:D5")) Is Nothing Then
TARGET.Select False '指定範囲に入っていない写真は除外
End If
Next 
TARGET

今回は見本で「A1からD5」にある写真・図を対象にしました。
なので「Range(“A1:D5”)) Is Nothing」で範囲をしぼっています。

仕組みとして「TopLeftCell」で写真の左上、「BottomRightCell」で写真の右下を検知し、
対象範囲内にあるか確認しています。

その後、範囲内に該当する写真・図については選択した状態を維持するようになります。
実行した結果はこちら。

これで選択は出来ましたが、選択した写真・図を
「Chart」に貼り付ける必要があります。
しかし、通常の状態で「Chart」を生成すると選択した写真・図のサイズとは
異なってしまいます。

そこで現在の写真・図のサイズを格納し、そのサイズに見合った
「Chart」を生成する必要があります。

ではプログラムを見ていきましょう。

Dim WideValue, HighValue

With Selection
WideValue = .Width '幅を格納
HighValue = .Height '高さを格納
.Copy '対象をコピー

End With

現状は対象の写真を選択している状態です。
その選択した写真を対象に「WideValue = .Width」で写真・図の幅を格納し、「HighValue = .Height 」で写真・図の高さを格納します。
さらに貼り付けるため、対象をコピーしています。

では、チャートを作成して、対象の写真を貼り付けてみましょう。
プログラムはこちら

ActiveSheet.ChartObjects.Add(0, 0, WideValue, HighValue).Name = "Targerpicture" 'チャートの作成
ActiveSheet.ChartObjects("Targerpicture").Activate '作成したチャートをアクティブに
ActiveChart.Paste 'チャートに写真を貼り付ける
ActiveChart.ChartArea.Format.Line.Visible = msoFalse 'チャートの外枠をなくす

まずはチャートの作成の構文はこちらです。

ActiveSheet.ChartObjects.Add(左端からの距離, 上端からの距離, 幅, 高さ).Name = "チャートの名前"

左端からの距離と上端からの距離については今回は写真として保存するだけなので
それぞれ「0」とします。
幅と高さについては、先ほど変数に格納した「WideValue」「HighValue」が該当します。

そして今回はチャートの名前を「Targerpicture」としました。
こちらを２行目のプログラムでアクティブ状態にします。

さらに3行目の「ActiveChart.Paste」でチャートに写真を貼り付けます。
そして最後にチャートの外枠を無くしました。外周に黒い線が残ってもいい場合はこちらは省略してください。

ではこれでChart形式の写真・図ができました。

・②写真・図を保存して、そのパスを変数に格納する

ではChart形式で保存できるようになったので、
指定フォルダに保存&変数にパスを格納していきましょう。

プログラムはこのようになります。

Dim PhotoName As String

PhotoName = "C:\検証ファイル\" & "貼り付け用写真.jpg"

With ActiveSheet.ChartObjects("Targerpicture")
.Chart.Export PhotoName
.Delete
End With

では仕組みを紹介します。
現在は①でチャート形式にした写真・図を作成している状態です。

まず変数で写真・図を保存する名前をフルパスを含めて決めています。
つまり、フルパスで指名したフォルダ・ファイル名で一旦
写真・図を保存するようになります。

見本では「ローカルディスクC」の「検証ファイル」に保存して、
写真・図名を「貼り付け用写真」としました。
写真・図なので拡張子を「.jpg」としています。

そして「Chart.Export＋先程のフルパス変数」で
写真・図として保存を実行します。

つまり、このフルパスが入った変数「PhotoName」が
画像を貼り付ける変数になります。

ちなみにここまでのプログラムを実行してみましょう。
指定ファイルにファイルが追加されました。

・③指定位置に貼り付ける

では実際に指定位置に貼り付けてみましょう。
まず構文から紹介したいと思います。

Set OBJSHAPE = ActiveSheet.Shapes.AddPicture( _
FileName:=ここにファイル名, _
LinkToFile:=False, _
SaveWithDocument:=TrueかFalse, _
Left:=左端からの貼り付け位置, _
Top:=上端からの貼り付け位置, _
Width:=写真・図の幅, _
Height:=写真・図の高さ)

では構文に当てはめていきましょう。
まず「FileName」は先程のフルパスが格納された変数「PhotoName」になります。

次に「LinkToFile」ですが図をグラフィック ファイルとリンクするかどうかを指定します。
今回は「False」にします。

「SaveWithDocument」については文書を保存するときに図も一緒に保存するかどうかを指定します。
今回は「True」にしておきましょう。

次に貼り付け位置についてです。
ここでは左端からの貼り付け位置が「Left」、上端からの貼り付け位置が「Top」となります。
ここには数値でもいいですが、セルを指定しても構いません。

今回は見本で「E7」に貼り付けたいと思います。

最後に写真のサイズを指定します。
写真の幅は「Width」、高さは「Height」で指定します。

通常のサイズを維持する場合は「-1」を入力します。
もちろん、直接サイズを入力しても構いません。

今回は見本で「E7」のセルのサイズに合わせて貼り付けます。

すべて足したプログラムはこちらです。

Set OBJSHAPE = ActiveSheet.Shapes.AddPicture( _
FileName:=PhotoName, _
LinkToFile:=False, _
SaveWithDocument:=True, _
Left:=ActiveSheet.Range("E7").Left, _
Top:=ActiveSheet.Range("E7").Top, _
Width:=ActiveSheet.Range("E7").Width, _
Height:=ActiveSheet.Range("E7").Height)

・④プログラム終了後は写真・図ファイルを削除する

写真・図を貼り付け終わったら最後に元の状態に戻すため
保存した写真・図を削除します。

削除する構文はこちら。

kill フルパス

では当てはめていきましょう。

フルパスは見本では「PhotoName」に格納しているので
「Kill PhotoName」だけで写真・図ファイルを削除できます。

これで一連の動作は完了です。

・プログラムまとめ

では①から④を組み合わせてみます。
結果はこちらです。

Sub 図を格納して貼り付け()

Dim WideValue, HighValue, PhotoName As String

For Each TARGET In ActiveSheet.Shapes '写真を繰り返し選択
　If Not Intersect(TARGET.TopLeftCell, Range("A1:D5")) Is Nothing And _
　　Not Intersect(TARGET.BottomRightCell, Range("A1:D5")) Is Nothing Then
　　　TARGET.Select False '指定範囲に入っていない写真は除外
　End If
Next TARGET

With Selection
　WideValue = .Width '幅を格納
　HighValue = .Height '高さを格納
　.Copy '対象をコピー
End With　

ActiveSheet.ChartObjects.Add(0, 0, WideValue, HighValue).Name = "Targerpicture" 'チャートの作成
ActiveSheet.ChartObjects("Targerpicture").Activate '作成したチャートをアクティブに
ActiveChart.Paste 'チャートに写真を貼り付ける
ActiveChart.ChartArea.Format.Line.Visible = msoFalse 'チャートの外枠をなくす

PhotoName = "C:\検証ファイル\" & "貼り付け用写真.jpg"

With ActiveSheet.ChartObjects("Targerpicture")
　.Chart.Export PhotoName '写真を名前をつけて保存
　.Delete
End With

Set OBJSHAPE = ActiveSheet.Shapes.AddPicture( _
　　　　　　　　  FileName:=PhotoName, _
                          LinkToFile:=False, _
　　　　　　　　  SaveWithDocument:=True, _
　　　　　　　　  Left:=ActiveSheet.Range("E7").Left, _
　　　　　　　　  Top:=ActiveSheet.Range("E7").Top, _
　　　　　　　　  Width:=ActiveSheet.Range("E7").Width, _
　　　　　　　　  Height:=ActiveSheet.Range("E7").Height) '貼り付け

Kill PhotoName '写真を消す

End Sub

長いですが、これで写真・図を格納して貼り付けるプログラムができました。
では実践してみましょう。

今回は「A1からD5」内の写真・図を格納して
「E7」に貼り付けます。

実行した結果はこちら。

狙い通り、貼り付けることができていますね。
サイズもセルの大きさに合わせて貼り付けてくれています。

⬛︎応用:見本のプログラム

ここからは先程のプログラムを応用したプログラムの事例を紹介します。

・格納した写真・図をブック内の全てのシートに貼り付ける。

まずは写真・図を格納して、ブック内のシート全ての指定位置に
貼り付けてみましょう。

今回は先頭のシートの「A1からD5」の中の写真・図を
他の全てのシートの「E7」に貼り付けるプログラムを見てみましょう。

Sub 図を格納して貼り付け()

Dim WideValue, HighValue, PhotoName As String, SheetNo, cycle

For Each TARGET In ActiveSheet.Shapes '写真を繰り返し選択
  If Not Intersect(TARGET.TopLeftCell, Range("A1:D5")) Is Nothing And _
     Not Intersect(TARGET.BottomRightCell, Range("A1:D5")) Is Nothing Then 
     TARGET.Select False '指定範囲に入っていない写真は除外
  End If
Next TARGET

With Selection
  WideValue = .Width '幅を格納
  HighValue = .Height '高さを格納
  .Copy '対象をコピー
End With

ActiveSheet.ChartObjects.Add(0, 0, WideValue, HighValue).Name = "Targerpicture" 'チャートの作成
ActiveSheet.ChartObjects("Targerpicture").Activate '作成したチャートをアクティブに
ActiveChart.Paste 'チャートに写真を貼り付ける
ActiveChart.ChartArea.Format.Line.Visible = msoFalse 'チャートの外枠をなくす

PhotoName = "C:\検証ファイル\" & "貼り付け用写真.jpg"

With ActiveSheet.ChartObjects("Targerpicture")
  .Chart.Export PhotoName '写真を名前をつけて保存
  .Delete
End With

SheetNo = Sheets.Count

For cycle = 2 To SheetNo Step 1
  Sheets(cycle).Activate
  Set OBJSHAPE = ActiveSheet.Shapes.AddPicture( _
                           FileName:=PhotoName, _
                           LinkToFile:=False, _
                           SaveWithDocument:=True, _
                           Left:=ActiveSheet.Range("E7").Left, _
                           Top:=ActiveSheet.Range("E7").Top, _
                           Width:=ActiveSheet.Range("E7").Width, _
                           Height:=ActiveSheet.Range("E7").Height) '貼り付け
Next cycle

Kill PhotoName '写真を消す

End Sub

「SheetNo」に全体のシート数をカウントして
「For Next」で貼り付けてシート数分貼り付けるようにしています。

通常、シートを繰り返し選択する場合は「For Each 変数 In Worksheets」
を使用しますが、貼り付けるシートを変則的に応用するために
今回はシート番号で対象シートをアクティブにさせています。

⬛︎公式の説明

わかりやすいように説明したため公式と使用する語句が異なりますが
マイクロソフト公式の説明については下記のリンクを参照してください☟

Shapes.AddPicture メソッド (PowerPoint) | Microsoft Learn

⬛︎まとめ

いかがだったでしょうか。
本記事の内容を活用すると、図を変数のように活用することができます。

エクセル内で図を定期的に指定位置に貼り付けたりする際には便利です。
署名の貼り付けなどにも活用できますね！

是非参考にしてみてください。
それでは次回の記事でお会いしましょう。

その中でも容量が大きい写真の軽量化について説明したいと思います。

さらに今回はシート・ブック内すべての写真をまとめて
軽量化できるプログラムを紹介しますので是非参考にしてみてください。

それではみていきましょう！

⬛︎こんなことができる！

シート・ブック内の全ての写真を軽量化することができる

⬛︎忙しい人向けのコピぺ用プログラム

・シート内の写真の軽量化

Sub シート内の画像軽量化()

Dim SelectPictures As Picture '対象の写真
Dim LeftPosition As Double, TopPosition As Double '左端・上端からの距離

For Each SelectPictures In ActiveSheet.Pictures
　If TypeName(SelectPictures) <> "OLEObject" Then
　　SelectPictures.Select
　　LeftPosition=SelectPictures.Left
　　TopPosition=SelectPictures.Top
　　Selection.Cut
　　ActiveSheet.PasteSpecial Format:="図(JPEG)"
　　Selection.Left=LeftPosition
　　Selection.Top=TopPosition
　End If
Next

End Sub

・ブック内の写真の軽量化

Sub ブック内の画像軽量化()

Dim SelectPictures As Picture '対象の写真
Dim LeftPosition As Double, TopPosition As Double '左端・上端からの距離
Dim CycleBook As Worksheet '対象のシート

For Each CycleBook In Worksheets 'シートを繰り返し格納
　CycleBook.Activate 'シートをアクティブ
　　For Each SelectPictures In ActiveSheet.Pictures　
　　If　TypeName(SelectPictures)<>"OLEObject"Then
　　　SelectPictures.Select
　　　LeftPosition=SelectPictures.Left
　　　TopPosition=SelectPictures.Top
　　　Selection.Cut
　　　ActiveSheet.PasteSpecial Format:="図(JPEG)"
　　　Selection.Left=LeftPosition
　　　Selection.Top=TopPosition
　　　EndIf
　Next
Next
End Sub

⬛︎写真が容量が大きい理由

まず、プログラムを紹介するにあたり
なぜ、写真の容量が多いか理解しておきましょう。

見本でフリー素材の図を用意しました。

綺麗ですねー！

では図を拡大してみましょう。

図を拡大してみましょう。

拡大しても画質は綺麗ですね。
実はこの現象が容量増加の原因となります。

原理を説明すると、現在のサイズは写真本来のサイズが100％でなく
現在のサイズ以上の画質を持っていることになります。
言い方を変えれば余分な容量を使っているということになります。

なので今回は現在のサイズに合わせて容量を適正にする方法です。
では本題に移りましょう。

⬛︎図を軽量化するプログラム

ではプログラムを紹介します。
先程の説明で容量の増加の原因は余分な容量を写真が抱えている
ことが原因でした。

解決する方法として対象の図を切り取って再度そのサイズで
図として貼り付けます。そうするとそのサイズに合わせた容量で
貼り付けるので、その差ぶんの容量が減る仕組みです。

プログラムの構造を紹介します。

対象の図.Select
Selection.Cut
ActiveSheet.PasteSpecial Format:=“図 (JPEG)”

では説明です。
1行目の「対象の図.Select」では軽量化したい図を選択します。
2行目の「Selection.Cut」では先程選択した図を切り取ります。
3行目の「ActiveSheet.PasteSpecial Format:=“図 (JPEG)”」
では切り取った写真を今のサイズの容量に合わせて貼り付けます。

これで1つの対象の図を軽量化することができます。
後はブックまたはシート内の全ての写真を繰り返し選択して
上記の処理を行えばいいだけです。

では実践編を見てみましょう。

⬛︎対象シート内の写真を軽量化する

ではこれまでの説明した内容をまとめて
シート内の写真をすべて軽量化してみましょう。

まず、シート内の写真を繰り返し選択するプログラムを紹介します。
プログラムはこちらです。

For Each 変数 In ActiveSheet.Pictures

‘ここに処理プログラム

Next

これでシート内の写真を繰り返し変数に入れていきます。

もう一つ課題があります。
それは選択した写真が「ActiveX」でないことを確認しないといけません。

「ActiveX 」とは開発タブの「挿入」にある「ActiveXコントロール」が
該当します。なぜ、ActiveX出ないことを確認する必要があるかというと
「Pictures 」で繰り返し変数に格納してますが、ActiveXも対象となってしまいます。

さらにActiveXでVBAを動かしている人も多いでしょうから
軽量化にするプログラムを実行するとActiveXが図になってしまうということに
なりかねません。

そこでActiveXか判別できるプログラムは下記のようになります。

If TypeName(変数) <> “OLEObject” Then
’ここに処理内容
End If

条件の「OLEObject」とはActiveXを含むので
OLEObjectでないことを条件として処理します。

さらにもう一つ課題があります。

それは切り取った位置と貼り付けた位置が異なることです。
手動で切り取ってみればわかるのですが、貼り付けの位置は現在選択しているセルになります。

そこで、切り取る前に現在の位置を記録しておき
貼り付けた際には記録した位置に戻す必要があります。

プログラムはこちらです。

左端からの写真の距離変数 = 変数.Left
上端からの写真の距離変数 = 変数.Top

‘ここに写真を切り取って貼り付けるプログラム

Selection.Left = 左端からの写真の距離変数
Selection.Top = 上端からの写真の距離変数

こうなります。
左端・上端からの写真の距離を変数に格納しておき、
貼り付け後に写真の位置を元の位置に戻します。

では総まとめです。
これまでの切り取って写真で貼り付ける、シート内の写真を順次選択する、
写真の位置を元に戻すプログラムを一つにします。

結果はこのようになります。

Sub シート内の画像軽量化()

Dim SelectPictures As Picture '対象の写真
Dim LeftPosition As Double, TopPosition As Double '左端・上端からの距離

For Each SelectPictures In ActiveSheet.Pictures
　If TypeName(SelectPictures) <> "OLEObject" Then
　　SelectPictures.Select
　　LeftPosition=SelectPictures.Left
　　TopPosition=SelectPictures.Top
　　Selection.Cut
　　ActiveSheet.PasteSpecial Format:="図(JPEG)"
　　Selection.Left=LeftPosition
　　Selection.Top=TopPosition
　End If
Next

End Sub

これで完成です。
今回は見本で下図のようなシートを用意しました。

シートの容量を見てみましょう。

「3152KB」と、なかなか大きいですね。

これをプログラムを実行するとこのようになりました。

「288KB」と容量が10倍以上小さくなっていますね。

⬛︎対象ブック内の写真を軽量化する

今度はブック内に範囲を広げましょう。
考え方は先程と同様です。

シート内の写真の軽量化の処理を
ブック内にあるシートすべて繰り返し処理をすれば可能です。

ではブック内のシートをアクティブにする繰り返しプログラムを
紹介したいと思います。

Dim 変数　As Worksheet

For Each 変数 In ThisWorkbook.Worksheets

変数.Activate
’ここに処理
Next

これでアクティブブック内のシート全ての処理ができます。

では先ほどのプログラムに追加してみましょう。
このようになります。

Sub ブック内の画像軽量化()

Dim SelectPictures As Picture '対象の写真
Dim LeftPosition As Double, TopPosition As Double '左端・上端からの距離
Dim CycleBook As Worksheet '対象のシート

For Each CycleBook In Worksheets 'シートを繰り返し格納
　CycleBook.Activate 'シートをアクティブ
　　For Each SelectPictures In ActiveSheet.Pictures　
　　If　TypeName(SelectPictures)<>"OLEObject"Then
　　　SelectPictures.Select
　　　LeftPosition=SelectPictures.Left
　　　TopPosition=SelectPictures.Top
　　　Selection.Cut
　　　ActiveSheet.PasteSpecial Format:="図(JPEG)"
　　　Selection.Left=LeftPosition
　　　Selection.Top=TopPosition
　　　EndIf
　Next
Next
End Sub

これで先ほどシート内の写真を軽量化しましたが
ブック単位で軽量化することができます。

⬛︎公式の説明

わかりやすいように説明したため公式と使用する語句が異なりますが マイクロソフト公式の説明については下記のリンクを参照してください。☟

Worksheet.PasteSpecial メソッド (Excel) | Microsoft Docs

⬛︎注意点

今回紹介した方法は、現在の写真のサイズに合わせて
画質を揃える方法でした。

しかし言い換えると、これまでは拡大しても画質が綺麗だったにも
かかわらず、プログラム実行後は拡大すると画質が悪くなります。

写真を使いまわしたい場合は別のバックアップ等取っておく
必要がありますので、実行の際は気をつけてください。

⬛︎まとめ

いかがだったでしょうか。
エクセルで図を貼り付ける機会がたくさんある方は
ファイルが重くなってないか確認してみてください。

重ければ入力や動作が遅くなる上
添付して送信する際にも時間がかかるなど
いいことはありません。

是非参考にしてみてください
それでは次回の記事でお会いしましょう。