View Single Post
 
Old 04-03-2018, 05:44 AM
p45cal's Avatar
p45cal p45cal is offline Windows 10 Office 2010 32bit
Expert
 
Join Date: Apr 2014
Posts: 956
p45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond reputep45cal has a reputation beyond repute
Default

Ditch Opic and:
Code:
Sub InsertPictures()
Dim vFilename           As Variant
Dim StartRow            As Long
Dim StartCol            As Long
Dim NumCols             As Long
Dim i                   As Long
Dim r                   As Long
Dim c                   As Long
    
vFilename = Application.GetOpenFilename( _
            FileFilter:="Pictures (*.gif;*.jpg;*.png), *.gif;*.jpg;*.png", _
            Title:="Select Picture", _
            MultiSelect:=True)
If Not IsArray(vFilename) Then Exit Sub
    
StartRow = 8
StartCol = 1
NumCols = 4
    
r = StartRow
c = StartCol
For i = LBound(vFilename) To UBound(vFilename)
  With ActiveSheet.Shapes.AddPicture(vFilename(i), Linktofile:=msoFalse, SaveWithDocument:=msoTrue, Left:=Cells(r, c).Left, Top:=Cells(r, c).Top, Width:=Cells(r, c).Width, Height:=Cells(r, c).Height)
    .LockAspectRatio = msoFalse
  End With
  If i Mod NumCols = 0 Then
    r = r + 2
    c = StartCol
  Else
    c = c + 2
  End If
Next i
End Sub
Reply With Quote