Forum Discussion

brady's avatar
brady
Copper Contributor
May 01, 2018

VBA help for a Macro (inserting picture from file)

Hi,   I am new to VBA and macros and I was hoping that someone could help me writing the VBA to insert a photo from your personal files. I created the button, but I just need to write the VBA to pu...
Excel on Mac
Macros & VBA
Matt Mickle's avatar
Matt Mickle
Bronze Contributor
May 01, 2018

Brady-

 

Please follow the below steps to accomplish your task:

 

1. Open the Visual Basic Editor (VBE) using Alt + F11

2. Insert > Module

3. Paste the below code in the new code module

 

Sub GetPic()
Dim fNameAndPath As Variant
Dim img As Picture
fNameAndPath = Application.GetOpenFilename(Title:="Select Picture To Be Imported")
If fNameAndPath = False Then Exit Sub
    Set img = ActiveSheet.Pictures.Insert(fNameAndPath)
    With img
       'Resize Picture to fit in the range....
       .Left = ActiveSheet.Range("D9").Left
       .Top = ActiveSheet.Range("D9").Top
       .Width = ActiveSheet.Range("D9:H9").Width
       .Height = ActiveSheet.Range("D9:D28").Height
       .Placement = 1
       .PrintObject = True
    End With
End Sub

4. Go back to the worksheet

5. Right Click on the button > Assign Macro

6. Select the GetPic Macro

 

After following these steps you should get the expected result.

tghendrick's avatar
tghendrick
Copper Contributor
Nov 26, 2019

Hey Matt Mickle 

 

I'm having problems with this Macro for inserting photos. I copied it from a PC parallel to use on my Mac but it's keeps telling me the file doesn't exist. Can you help? 

I uploaded a test file, the other one is a much larger file. 

 

Sub InsertAnyPicture() Dim image As String Columns("A:B").Select Selection.Insert Shift:=xlToRight Range("A2").Select ActiveCell.FormulaR1C1 = _ "=CONCATENATE(""E:\Users\Tamara\Desktop\MIASTOCK INVENTORY\images\"",RC[2],"".jpeg"")" Application.Goto Reference:="OFFSET(R2C1,0,0,COUNTA(C3)-1,1)" Selection.FillDown Application.Goto Reference:="OFFSET(R2C1,0,0,COUNTA(C3)-1,1)" Set InputedRange = Range(Selection.Address) For Each C In InputedRange C.RowHeight = 45.5 image = C.Value If File_Exists(image) = True Then Call AddPic(image, C.Offset(0, 1)) Else C.Offset(0, 1).Value = "NO FILE" End If If C.Value = "" Then Exit Sub End If Next C Range("a1").Select Columns(1).EntireColumn.Delete End Sub Sub AddPic(sFile As String, r As Range) With r.Areas(1) ActiveSheet.Shapes.AddPicture FileName:=sFile, _ LinkToFile:=msoFalse, _ SaveWithDocument:=msoTrue, _ Top:=.Top, Left:=.Left, _ Height:=45, Width:=45 End With End Sub Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean 'Returns True if the passed sPathName exist 'Otherwise returns False On Error Resume Next If sPathName <> "" Then If IsMissing(Directory) Or Directory = False Then File_Exists = (Dir$(sPathName) <> "") Else File_Exists = (Dir$(sPathName, vbDirectory) <> "") End If End If End Function

Resources