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

Open in new window

ASKER CERTIFIED SOLUTION
cErasmus

Our community of experts have been thoroughly vetted for their expertise and industry experience.

Join our community to see this answer!
Unlock 1 Answer and 14 Comments.
Start Free Trial
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