XL 2010 rajouter une colone dans la macro

bredeche

XLDnaute Occasionnel
bonjour

mon code fonctionne très bien mais je voudrais savoir comment je pourrais en plus de reporté la colonne B dans (synoptique) la construction de l’organigramme la colonne c

Code:
Dim colonne, débutOrg, f, forga, inth, intv, Tbl(), n
Sub DessineNomenclatureShapes()
   Set forga = Sheets("synoptique")
   Set f = Sheets("base de donné")
   Tbl = f.Range("A2:B" & 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("b4")
   colonne = 0
   inth = 70
   intv = 18
   créeShape Tbl(1, 1), 1, Tbl(1, 2)
End Sub
Sub créeShape(parent, niv, Attribut) ' procédure récursive
  hauteurshape = 18
  largeurshape = 120
  colonne = colonne + 1
  forga.Shapes.AddShape(msoShapeFlowchartAlternateProcess, 10, 10, largeurshape, hauteurshape).Name = parent
  forga.Shapes(parent).Line.ForeColor.SchemeColor = 1
  txt = parent & " : " & Attribut
  With forga.Shapes(parent)
    .TextFrame.Characters.Text = txt
    .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
    .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
    .Fill.ForeColor.RGB = f.Cells(2, 1).Interior.Color
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Color = vbRed
  End With
  forga.Shapes(parent).Left = débutOrg.Left + niv * inth
  forga.Shapes(parent).Top = débutOrg.Top + intv * colonne
  For i = 2 To n
    If Tbl(i, 1) = parent And niv > 1 Then
      p = InStrRev(Tbl(i, 1), "."): Shapepère = Left(Tbl(i, 1), p - 1)
      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), 2
   End If
   p = InStrRev(Tbl(i, 1), "."): tmp = Left(Tbl(i, 1), p - 1)
   If tmp = parent Then créeShape Tbl(i, 1), niv + 1, Tbl(i, 2)
  Next i
End Sub

merci de votre aide
 

Statistiques des forums

Discussions
312 089
Messages
2 085 206
Membres
102 819
dernier inscrit
Michew13