XL 2010 Organigramme automatique non centré

Dim colonne, débutOrg, forga, inth, intv, Tbl(), n
Sub DessineOrgaClic()
  Set forga = Sheets("orga")
  Set f = Sheets("bd")
  Tbl = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value
  n = UBound(Tbl)
  For Each s In forga.Shapes
    If s.Type = 17 Or s.Type = 1 Then s.Delete
  Next
  Set débutOrg = forga.Range("A10")
  colonne = 0
  inth = 55
  intv = 35
  créeShape Tbl(1, 1), 1, Tbl(1, 3)
End Sub
Sub créeShape(parent, niv, Attribut) ' procédure récursive
  hauteurshape = 20
  largeurshape = 50
  forga.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, largeurshape, hauteurshape).Name = parent
  forga.Shapes(parent).Line.ForeColor.SchemeColor = 22
  txt = parent
  With forga.Shapes(parent)
   .TextFrame.Characters.Text = txt
   .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 7
   .OnAction = "detail"
  End With
  colonne = colonne + 1
  forga.Shapes(parent).Left = débutOrg.Left + inth * colonne
  forga.Shapes(parent).Top = débutOrg.Top + intv * (niv - 1)
  For i = 1 To n
    If Tbl(i, 1) = parent And niv > 1 Then
      shapePère = Tbl(i, 2)
      forga.Shapes.AddConnector(msoConnectorElbow, 100, 100, 100, 100).Name = parent & "c"
      forga.Shapes(parent & "c").Line.ForeColor.SchemeColor = 22
      forga.Shapes(parent & "c").ConnectorFormat.BeginConnect forga.Shapes(shapePère), 3
      forga.Shapes(parent & "c").ConnectorFormat.EndConnect forga.Shapes(parent), 1
    End If
    If Tbl(i, 2) = parent Then créeShape Tbl(i, 1), niv + 1, Tbl(i, 3)
  Next i
End Sub
Sub detail()
  On Error Resume Next
  For Each s In ActiveSheet.Shapes
     s.Fill.ForeColor.RGB = RGB(255, 255, 255)
  Next s
  On Error GoTo 0
  Set fbd = Sheets("bd")
  s = Application.Caller
  Set result = fbd.[a:a].Find(what:=s)
  [d2] = result
  [d3] = result.Offset(, 1)
  [d4] = result.Offset(, 2)
  [d5] = result.Offset(, 3)
  [d6] = result.Offset(, 4)
  ActiveSheet.Shapes(s).Fill.ForeColor.RGB = RGB(255, 0, 0)
End Sub