Вставить изображение в электронную таблицу Excel - VBA - PullRequest
Новая
       23

Вставить изображение в электронную таблицу Excel - VBA

5 голосов
/ 12 сентября 2011

Мне нужно вставить изображение в электронную таблицу через Excel VBA, чтобы при перемещении файла Excel изображение все равно отображалось. Как я могу это сделать?

Ответы [ 2 ]

13 голосов
/ 12 сентября 2011

Этот код вставит изображение на текущий лист и поместит его в ячейку 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
0 голосов
/ 12 сентября 2011

Вы пытались использовать макро-рекордер?

Вот что он произвел для меня: 

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
...