Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…