Excelスプレッドシートに画像を埋め込む - VBA

Question

Excel VBAでスプレッドシートに画像を埋め込む必要があるため、Excelファイルを再配置するたびに画像が表示されます。これどうやってするの？

Answer 1

このコードは、セルE10での現在のシートや位置、それを上の画像を挿入します：

Set oPic = Application.ActiveSheet.Shapes.AddPicture("d:\temp\mypic.jpg", False, True, 1, 1, 1, 1) 
oPic.ScaleHeight 1, True 
oPic.ScaleWidth 1, True 

oPic.Top = Range("E10").Top 
oPic.Left = Range("E10").Left 

Answer 2

あなたは、マクロレコーダーを使用してみましたか？

これは、それは私のために生産するものです。また

Sub Macro1() 

    ActiveSheet.Pictures.Insert ("C:\mypicture.jpg") 

End Sub 

Google検索用語を使用して情報のトン：「VBA Excelを使用して画像を挿入」。以下のコードは、ExcelTipから取られ、元の著者Erlandsen Data Consultingのすべてのクレジットに付与されています。

以下のマクロを使用すると、ワークシート内の任意の範囲に画像を挿入することができ、画像自体が元の位置にとどまっている限り、そのまま残されます。

画像を水平および/または垂直にセンタリングすることができます。

Sub TestInsertPicture() 
    InsertPicture "C:\FolderName\PictureFileName.gif", _ 
     Range("D10"), True, True 
End Sub 

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _ 
    CenterH As Boolean, CenterV As Boolean) 
    ' inserts a picture at the top left position of TargetCell 
    ' the picture can be centered horizontally and/or vertically 
    Dim p As Object, t As Double, l As Double, w As Double, h As Double 
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 
    If Dir(PictureFileName) = "" Then Exit Sub 
    ' import picture 
    Set p = ActiveSheet.Pictures.Insert(PictureFileName) 
    ' determine positions 
    With TargetCell 
     t = .Top 
     l = .Left 
     If CenterH Then 
      w = .Offset(0, 1).Left - .Left 
      l = l + w/2 - p.Width/2 
      If l < 1 Then l = 1 
     End If 
     If CenterV Then 
      h = .Offset(1, 0).Top - .Top 
      t = t + h/2 - p.Height/2 
      If t < 1 Then t = 1 
     End If 
    End With 
    ' position picture 
    With p 
     .Top = t 
     .Left = l 
    End With 
    Set p = Nothing 
End Sub 

マクロを使用すると、写真を挿入してワークシートの任意の範囲に収めることができます。

Sub TestInsertPictureInRange() 
    InsertPictureInRange "C:\FolderName\PictureFileName.gif", _ 
     Range("B5:D10") 
End Sub 

Sub InsertPictureInRange(PictureFileName As String, TargetCells As Range) 
    ' inserts a picture and resizes it to fit the TargetCells range 
    Dim p As Object, t As Double, l As Double, w As Double, h As Double 
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub 
    If Dir(PictureFileName) = "" Then Exit Sub 
    ' import picture 
    Set p = ActiveSheet.Pictures.Insert(PictureFileName) 
    ' determine positions 
    With TargetCells 
     t = .Top 
     l = .Left 
     w = .Offset(0, .Columns.Count).Left - .Left 
     h = .Offset(.Rows.Count, 0).Top - .Top 
    End With 
    ' position picture 
    With p 
     .Top = t 
     .Left = l 
     .Width = w 
     .Height = h 
    End With 
    Set p = Nothing 
End Sub