Excel VBA Error - Unable to get the Insert property of the Picture Class

[KlausW]

Hi all, I get this error message when I run the VBA code, “Unable to get the Insert property of the Picture Class”. The VBA code, Showing images from a folder in a column in a sheet.

Some who can help. I have looked at this question here in the Forum

but cannot figure out how to merge the solution into my VBA code.

Some who can help. Any help will be appreciated.

Best regards Klaus W

Help from this Forum

Sub Sheet1_Rektangelafrundedehjørner1_Klik()

Dim pictname As String
Dim pastehere As Range
Dim pasterow As Long
Dim x As Long
Dim lastrow As Long

lastrow = Worksheets("Sheet1").Range("a1").CurrentRegion.Rows.Count
x = 2
For x = 2 To lastrow
Set pastehere = Cells(x, 1)
pasterow = pastehere.Row
Cells(pasterow, 2).Select 'This is where picture will be inserted

pictname = Cells(x, 1) 'This is the picture name
ActiveSheet.Pictures.Insert("D:\Billeder af VPL - Kopi\" & pictname & ".jpg").Select 'Path to where pictures are stored

With Selection

.Left = Cells(pasterow, 2).Left + (Cells(pasterow, 2).Width - .Width / 1)
.Top = Cells(pasterow, 2).Top + (Cells(pasterow, 2).Height - .Height / 1)


'.Left = Cells(pasterow, 1).Left
'.Top = Cells(pasterow, 0.5).Top

.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 120#
.ShapeRange.Width = 75#
.ShapeRange.Rotation = 0#
End With

Next

Range("a1").Select

End Sub

 

[saboh12617]

Hello,
I've never seen this .Pictures.Insert instruction before in VBA. It might be related to an external library. I would suggest you, among other things such as avoiding .Select, to use the Shapes.AddPicture method (Excel) instruction instead, which allows you to define the parameters you set afterwards imediately during the insertion.

 

[jkpieterse]

Does it error on every one, or on specific ones?

 

[KlausW]

Does it error on every one, or on specific ones?

It does it at all the pictures

 

[jkpieterse]

It seems to work fine on my end. Just to be sure:

• The worksheet in question is not protected
• The picture files are in the location where they are supposed to be
• The string that is created in this line:
  ActiveSheet.Pictures.Insert("D:\Billeder af VPL - Kopi\" & pictname & ".jpg").Select
  is a valid name and path to a picture file

 

[RoryA]

Untested, but perhaps try this:

Const PIC_PATH As String = "D:\Billeder af VPL - Kopi\"
Sub Sheet1_Rektangelafrundedehjørner1_Klik()

   Dim pictname As String
   Dim pastehere As Range
   Dim pasterow As Long
   Dim x As Long
   Dim lastrow As Long
   Dim ws As Worksheet
   Set ws = Worksheets("Sheet1")
   lastrow = ws.Range("a1").CurrentRegion.Rows.Count
   x = 2
   For x = 2 To lastrow
      Set pastehere = Cells(x, 1)
      pasterow = pastehere.Row
      Dim pasteCell As Range
      Set pasteCell = Cells(pasterow, 2) 'This is where picture will be inserted
      
      pictname = PIC_PATH & Cells(x, 1) & ".jpg"  'This is the picture name
      If Dir(pictname) <> "" Then
         Dim sh As Shape
         Set sh = ws.Shapes.AddPicture(Filename:=pictname, _
                                       linktofile:=msoFalse, _
                                       savewithdocument:=msoCTrue, _
                                       Left:=pasteCell.Left, _
                                       Top:=pasteCell.Top, _
                                       Height:=-1, _
                                       Width:=-1)
         With sh
            .LockAspectRatio = msoFalse
            .Height = 120#
            .Width = 75#
            .Rotation = 0#
         End With
         
      Else
         MsgBox "Image: '" & pictname & "' does not exist"
      End If
   Next

End Sub

 

[KlausW]

Untested, but perhaps try this:

Const PIC_PATH As String = "D:\Billeder af VPL - Kopi\"
Sub Sheet1_Rektangelafrundedehjørner1_Klik()

   Dim pictname As String
   Dim pastehere As Range
   Dim pasterow As Long
   Dim x As Long
   Dim lastrow As Long
   Dim ws As Worksheet
   Set ws = Worksheets("Sheet1")
   lastrow = ws.Range("a1").CurrentRegion.Rows.Count
   x = 2
   For x = 2 To lastrow
      Set pastehere = Cells(x, 1)
      pasterow = pastehere.Row
      Dim pasteCell As Range
      Set pasteCell = Cells(pasterow, 2) 'This is where picture will be inserted
     
      pictname = PIC_PATH & Cells(x, 1) & ".jpg"  'This is the picture name
      If Dir(pictname) <> "" Then
         Dim sh As Shape
         Set sh = ws.Shapes.AddPicture(Filename:=pictname, _
                                       linktofile:=msoFalse, _
                                       savewithdocument:=msoCTrue, _
                                       Left:=pasteCell.Left, _
                                       Top:=pasteCell.Top, _
                                       Height:=-1, _
                                       Width:=-1)
         With sh
            .LockAspectRatio = msoFalse
            .Height = 120#
            .Width = 75#
            .Rotation = 0#
         End With
        
      Else
         MsgBox "Image: '" & pictname & "' does not exist"
      End If
   Next

End Sub

I try it, thanks KW

 

[KlausW]

I try it, thanks KW

Hi RoryA
It works as it should, thanks a lot for helping.
Best regards Klaus W