KlausW
Active Member
- Joined
- Sep 9, 2020
- Messages
- 453
- Office Version
- 2016
- Platform
- Windows
Hi
I am using the first part of the code to copy names of pictures that I want to inset. The next code, inset pictures. The pictures name a standing from B2 and down.
I got 3 things that I want Excel to do.
First. When I run the VBA-code Excel inset pictures, the name of it stands in B2 and down, but it also put in allot of pictures that’s not pictures. Whit this text in, "The linked image cannot be displayed. The file may have been moved, renamed or deleted."
Secund. I should like to inset different kind of picture format, like *.jpg and *.png
Third. I should like to center the picture in the cell an reseize it to 13x16 cm.
Al help will be appreciated.
Klaus W
I am using the first part of the code to copy names of pictures that I want to inset. The next code, inset pictures. The pictures name a standing from B2 and down.
I got 3 things that I want Excel to do.
First. When I run the VBA-code Excel inset pictures, the name of it stands in B2 and down, but it also put in allot of pictures that’s not pictures. Whit this text in, "The linked image cannot be displayed. The file may have been moved, renamed or deleted."
Secund. I should like to inset different kind of picture format, like *.jpg and *.png
Third. I should like to center the picture in the cell an reseize it to 13x16 cm.
Al help will be appreciated.
Klaus W
VBA Code:
Sub Bilag_Rektangelafrundedehjørner1_Klik()
'Copy the data
Sheets("Stamdata").Range("p9:p16").Copy
Sheets("Bilag").Range("b2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Call Rektangelafrundedehjørner3_Klik
End Sub
VBA Code:
Sub Rektangelafrundedehjørner3_Klik()
Dim pictname As String
Dim pastehere As Range
Dim pasterow As Long
Dim x As Long
Dim lastrow As Long
lastrow = Worksheets("Bilag").Range("B1").CurrentRegion.Rows.Count
x = 2
For x = 2 To lastrow
Set pastehere = Cells(x, 1)
pasterow = pastehere.Row
Cells(pasterow, 1).Select 'This is where picture will be inserted
pictname = Cells(x, 2) 'This is the picture name
ActiveSheet.Pictures.Insert("C:\Users\k-wit\OneDrive\F-div\Rejseafregning\Bilag\" & pictname & ".png").Select 'Path to where pictures are stored
With Selection
.Left = Cells(pasterow, 2).Left + (Cells(pasterow, 3).Width - .Width / 1)
.Top = Cells(pasterow, 2).Top + (Cells(pasterow, 1).Height - .Height / 1.1)
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 370#
.ShapeRange.Width = 470#
.ShapeRange.Rotation = 0#
End With
Next
End Sub