I have data with a lot of shapes in them and I would like to align them with the

Question

I have data with a lot of shapes in them and I would like to align them with the same distance to one another horizontally,

FYI

You can find my sample and the actual macro I used to make the data below :

http://answers.microsoft.com/en-us/office/forum/office_2010-excel/multiple-shape-create-macro-excel-or-word-or-pp/706ae8e7-26fd-4eb0-bf17-551e1601dbe6

If you run this you will see my problem: the shapes are fine but there is no rule to the alignment.

The problem is after the macro, I have to manually position the shapes.

I could do that but I need the distance between the shapes to be perfectly equal, otherwise it won

Explanation / Answer

I've added a column to specify the gap between shapes.

I increased the gap per shape to demonstrate. The code is:

Sub Shapes()
   Dim S As Shape
   Dim varShapeInfo As Variant
   Dim i As Integer, j As Integer
   Dim varFontColor As Variant
   Dim varFontColors As Variant
   Dim intSpace As Integer
   Dim intLen As Integer
   Dim intWordLen As Integer
   Dim dblSL      As Double
   Dim dblSW      As Double
   varShapeInfo = Sheets("Sheet2").Range("A1").CurrentRegion '''<= change this
   Sheets.Add
   For i = 2 To UBound(varShapeInfo, 1)
      Set S = ActiveSheet.Shapes.AddShape(CLng(varShapeInfo(i, 1)), Range(varShapeInfo(i, 6)).Left, Range(varShapeInfo(i, 6)).Top, varShapeInfo(i, 7), varShapeInfo(i, 8))
      S.Select
      With Selection.ShapeRange
         .Fill.ForeColor.RGB = RGB(Split(varShapeInfo(i, 3), ",")(0), Split(varShapeInfo(i, 3), ",")(1), Split(varShapeInfo(i, 3), ",")(2))
         .Line.ForeColor.RGB = RGB(Split(varShapeInfo(i, 5), ",")(0), Split(varShapeInfo(i, 5), ",")(1), Split(varShapeInfo(i, 5), ",")(2))
         .TextFrame2.TextRange.Characters.Text = varShapeInfo(i, 2)
         On Error Resume Next
         varFontColors = Split(varShapeInfo(i, 4), ";")
         intSpace = 0: intLen = 0
         For j = 0 To UBound(varFontColors, 1)
          
            intLen = intSpace + 1
            intSpace = InStr(intLen, .TextFrame2.TextRange.Characters.Text, " ")
            If intSpace = 0 Then
               intSpace = .TextFrame2.TextRange.Characters.Count - intLen + 1
               intWordLen = intSpace
            Else
               intWordLen = intSpace - intLen
            End If
            .TextFrame2.TextRange.Characters(intLen, intWordLen).Font.Fill.ForeColor.RGB = RGB(Split(varFontColors(j), ",")(0), Split(varFontColors(j), ",")(1), Split(varFontColors(j), ",")(2))
            .TextFrame.AutoSize = True
          
         Next j
      ''' distribute the shapes
      End With
      If dblSL = 0 Then

         ''' get the position and width of the first shape

         dblSL = Selection.ShapeRange.Left
         dblSW = Selection.ShapeRange.Width
      Else

         ''' position the next shapes

         Selection.ShapeRange.Left = dblSL + dblSW + varShapeInfo(i, 9)
         dblSL = Selection.ShapeRange.Left
         dblSW = Selection.ShapeRange.Width
      End If
   Next i

   On Error GoTo 0
End Sub

Shape Text BackColor FontColor BorderColor Position (Cell) Size Width Size Height Gap 1 I 255,255,255 0,32,96 0,0,0 L1 10 20 5 1 announced 255,255,255 21,96,189 0,0,0 N1 90 20 20 1 today 255,255,255 223,95,14 0,0,0 Q1 50 20 40 1 that I am forming a presidential exploratory committee 255,255,255 0,32,96;0,32,96;21,96,189;21,96,189;0,0,0;41,171,135;41,171,135;0,32,96 0,0,0 S1 540 20 80

Related Questions

Navigate

• Browse (All)
• Browse I
• Subjects

---

---

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.