VBA code to insert pictures

Question

Hi,

I have wrote a small VBA program to upload pictures from a preset path taking file or picture name from a cell and inserting it on the same cell and resizing it to fit in that cell.

Then I dragged that sheet with pictures in an another normal excel workbook(not enabled) and mailed it. But on receiving the file pictures were not there and same thing happens when I change the folder name from which pictures where inserted. Also size of the excel file was 10Mb instead of being 2-3Mbs when done manually. Kindly suggest a way to overcome this.

Thanks.

Answer 1

How does the code determines where to place the shape?

and what if I want to control in which cell or in which sheet the shape should go?

Code looks good, except the Debug.Print line, you don't need it.

The Shape is placed where you setup the R object, I assume that R is a Range object. So if you

  Set R = Range("B3:F5")

or

  Set R = Cells(7,12)

the shape is places exactly over this cell(s).

And if you want to place the Shape in another sheet use

  Set Sh = Worksheets(2).Shapes.AddPicture( etc.

But as the cells might have other positions in that sheet, you must (should) refer to the cells in that sheet too:

  With Worksheets("MySheet")

    Set R = .Range("B3:F5")

    Set Sh = .Shapes.AddPicture("E:\Accord\Airtel\Pics" & fol & " P" & Name _

      & ".jpeg", msoFalse, msoTrue, R.Left, R.Top, R.Width, R.Height)

  End With

Note the dot in front of Range and Shapes.

Andreas.

Answer 2

Not that good at coding but learning from various platform so here is my code:

Sub UPLOAD()

Application.ScreenUpdating = False

Dim fol As String

Dim name As String

Dim x As Long

Dim y As Long

Sheets("Site Details").Cells(6, 2).Select

fol = Cells(6, 2)

'MsgBox fol

Sheets("SNAPS").Select

For x = 1 To 24

For y = 1 To 5

Cells(x * 3, y).Select

name = Cells(x * 3, y)

'c = Cells(x * 3, y)

'MsgBox name

On Error Resume Next

ActiveSheet.Pictures.Insert("E:\Accord\Airtel\Pics" & fol & " P" & name & ".jpeg").Select

With Selection

.Left = Cells(x * 3, y).Left

.Top = Cells(x * 3, y).Top

.ShapeRange.LockAspectRatio = msoFalse

.ShapeRange.Height = 100#

.ShapeRange.Width = 100#

.ShapeRange.Rotation = 0#

.ShapeRange.ScaleWidth 1.9607141732, msoFalse, msoScaleFromTopLeft

.ShapeRange.ScaleHeight 1.65, msoFalse, msoScaleFromTopLeft

.ShapeRange.IncrementLeft 1.0714173228

.ShapeRange.IncrementLeft 1.0714173228

.ShapeRange.IncrementTop 1.0714173228

.ShapeRange.IncrementTop 1.0714173228

.Copy

ActiveSheet.Next.Cells(x * 3, y).Select

ActiveSheet.Pictures.Paste.Select

.ShapeRange.IncrementLeft 1.0714173228

.ShapeRange.IncrementLeft 1.0714173228

.ShapeRange.IncrementTop 1.0714173228

.ShapeRange.IncrementTop 1.0714173228

ActiveSheet.Previous.Select

End With

Next

Next

Sheets("SNAPS").Cells(1, 1).Select

Application.ScreenUpdating = True

End Sub

Answer 3

You have to set the SaveWithDocument argument to True:

https://docs.microsoft.com/en-us/office/vba/api/excel.shapes.addpicture

Have also a look on my reply here for a working code:

https://answers.microsoft.com/en-us/msoffice/forum/all/importing-and-arranging-images-in-excel-with-vba/7b13257e-addb-4994-9bcb-1ccb3bdf0d55

Andreas.

Answer 4

To get assistance with some code the you created, you would need to provide the code.

Answer 5

Hello Enthusiast

I am V. Arya, Independent Advisor, to work with you on this issue. Is it possible to post your VBA code (at least the relevant portion)?