troubleshooting Question

How to rearrange a large group of pictures in an excel file via VBA?

Avatar of kbay808
kbay808Flag for United States of America asked on
VBA
14 Comments1 Solution100 ViewsLast Modified:
I have a spreadsheet with a list of over 100 names in column A.  There is a picture next to each name.  I need to rearrange the names and pictures horizontally.  The names is easy enough, but is there a way to transpose the pictures? I did find some code that I posted below that can move the pictures, but I’m not sure if it can be modified to meet my needs.

Sub AlignMultipleShapes()
'PURPOSE: Align each shape in user's selection (first shape selected stays put)
'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault

Dim Shp1 As Shape
Dim Shp2 As Shape
Dim x As Integer
Dim y As Integer

'Count How Many Shapes Are Selected
  x = Windows(1).Selection.ShapeRange.Count

'Loop Through each selected Shape (align with first selected)
  For y = 1 To x
    If Shp1 Is Nothing Then
      Set Shp1 = Windows(1).Selection.ShapeRange(y)
    Else
      Set Shp2 = Windows(1).Selection.ShapeRange(y)
        
        'Align Left
          Shp2.Left = Shp1.Left
              
        'Align Right
          Shp2.Left = Shp1.Left + (Shp1.Width - Shp2.Width)
  
        'Align Top
          Shp2.Top = Shp1.Top
  
        'Align Bottom
          Shp2.Top = Shp1.Top + (Shp1.Height - Shp2.Height)
  
        'Align Middle (Horizontal Center)
          Shp2.Top = Shp1.Top + ((Shp1.Height - Shp2.Height) / 2)
  
        'Align Center (Vertical Center)
          Shp2.Left = Shp1.Left + ((Shp1.Width - Shp2.Width) / 2)
          
      End If
  Next y

End Sub
Join the community to see this answer!
Join our exclusive community to see this answer & millions of others.
Unlock 1 Answer and 14 Comments.
Join the Community
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 14 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros