VBA - Inserting, Selecting, Moving Pictures?

Hi, You could have a play with this.
This code originally related to small pictures of Flags that had been already inserted in the sheet.
The code just arranges then across & down the sheet.

Dim oPic As Shape, allpic As String
 Dim oP As String, ac As Integer, c, t
 Me.Pictures.Visible = True
  c = 10
  t = 10
  For Each oPic In Me.Shapes
   If oPic.Type = 13 Then
        With oPic 'ActiveSheet.Shapes(oPic.Name)
            .Width = 0
            .Height = 50
            .Top = t
            .Left = c
             c = c + 70
             If c >= 560 Then t = t + 70
             c = IIf(c >= 560, 10, c)
    .ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
    End With
         End If
              
     Next oPic

Regards Mick

Thanks for the quick reply. Do I need to do anything special to have that code work, other than copying and pasting? (Forgive my beginner knowledge)

It is returning a "Compile Error: Invalid outside procedure" and the "True" in the code is highlighted.

Thanks again for your help.

Hi, I don't quite understand your error ,but try this.
Right click your sheet tab. This sheet should have pictures (visible) Inserted from the drawing tool bar.
Select "View code", VB window appears.
From the VB Toolbar Select "Insert", "Module". New window appears. Paste the entire code below into the new window.
Close VB Window.
Click "Alt+F8" Macro Dialog box appears, Select the code "Pic", Click run fron the Right hand side Menu.
Pictures in you sheet should be aligned, across & down the sheet.(Hopefully)

Sub pic()
Dim oPic As Shape, allpic As String
 Dim oP As String, ac As Integer, c, t
 ActiveSheet.Pictures.Visible = True
  c = 10
  t = 10
  For Each oPic In ActiveSheet.Shapes
   If oPic.Type = 13 Then
        With oPic 'ActiveSheet.Shapes(oPic.Name)
            .Width = 0
            .Height = 50
            .Top = t
            .Left = c
             c = c + 70
             If c >= 560 Then t = t + 70
             c = IIf(c >= 560, 10, c)
    .ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
    End With
         End If
              
     Next oPic
End Sub

Regards Mick

Mick,

That is great!!! It is working like a charm. One question, what part of the code do I need to change to adjust the resulting size? In other words, the pictures are reduced, which I want, but not quite this small?

Thanks again, you are a huge help!!!!

hi, What you need to do is play with the Variables"c" & "t", as shown below.
I should change one Variable at a time and then review the result.
It very much dependent on what you want to achieve.

Sub Pic()
Dim oPic As Shape, allpic As String
 Dim oP As String, ac As Integer, c, t
 ActiveSheet.Pictures.Visible = True
  c = 10 ' These are start Borders (Left)
  t = 10 ' These are start Borders (Top)
  For Each oPic In ActiveSheet.Shapes
   If oPic.Type = 13 Then
        With oPic
            .Width = 0
            .Height = 120 '50'(Change Here)
            .Top = t
            .Left = c
             c = c + 150 '70'(Change Here)
             
          '(Change "560" Here "Both Lines Below")
             If c >= 400 Then t = t + 150 '70'(Change Here)
             c = IIf(c >= 400, 10, c) '560'(Change Here)

    .ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft
    End With
         End If
              
     Next oPic
  End Sub

Regards Mick