Hello all! I'm new to this website and have been scouring some forums on here to try to get a VBA code to work that selects every photo, pictures, or shape that is in an active cell's row. What my code does so far is insert photos from the file explorer but I'm trying to keep those inserted photos selected to move about afterward.
Here's what I've got so far:
The last For Each I found that selects every pictures in a preset column so it's the closest I've gotten. What am I missing? Any help would be greatly appreciated. Thank you!
Here's what I've got so far:
VBA Code:
Sub InsertMultiplePictures()
Dim Pictures() As Variant
Dim PictureFormat As String
Dim PicRng As Range
Dim PicShape As Shape
Dim myshapearray() As String
Dim ws As Worksheet
On Error Resume Next
Pictures = Application.GetOpenFilename(PictureFormat, MultiSelect:=True)
PicColIndex = Application.ActiveCell.Column
If IsArray(Pictures) Then
PicRowIndex = Application.ActiveCell.Row
For lLoop = LBound(Pictures) To UBound(Pictures)
Set PicRng = Cells(PicRowIndex, PicColIndex)
Set PicShape = ActiveSheet.Shapes.AddPicture(Pictures(lLoop), msoFalse, msoCTrue, PicRng.Left, PicRng.Top, PicRng.Width, PicRng.Height)
PicColIndex = PicColIndex + 1
Next
End If
For Each Shape In ActiveSheet.Shapes
If Shape.Left > Range("A1").Left + Range("A1").Width / 2 And Shape.Left < (Range("C1").Left - Range("B1").Width / 2) Then
k = k + 1
ReDim Preserve myshapearray(1 To k) As String
myshapearray(k) = Shape.Name
End If
Next
ActiveSheet.Shapes.Range(myshapearray).Select
End SubThe last For Each I found that selects every pictures in a preset column so it's the closest I've gotten. What am I missing? Any help would be greatly appreciated. Thank you!
