bredeche
XLDnaute Occasionnel
bonjour
je n'arrive pas a rajouter dans Mon synoptique les elements de la colone n°3
ci dessous mon code
Dim colonne, débutOrg, forga, inth, intv, Tbl(), n
Sub DessineOrga()
Set forga = Sheets("SYNOP ELEC")
Set f = Sheets("BD ELEC")
Set débutOrg = forga.Range("a1")
Tbl = f.Range("A2" & f.[A65000].End(xlUp).Row).Value
n = UBound(Tbl)
For i = 2 To n
If InStr(Tbl(i, 1), ".") = 0 Then Tbl(i, 4) = "0" Else p = InStrRev(Tbl(i, 1), "."): Tbl(i, 4) = Left(Tbl(i, 1), p - 1)
Next i
For Each s In forga.Shapes
If s.Type = 17 Or s.Type = 1 Then s.Delete
Next
colonne = 0
inth = 90
intv = 40
créeShape Tbl(1, 1), 1, Tbl(1, 2), Tbl(1, 3)
End Sub
Sub créeShape(parent, niv, Attribut, attribut2) ' procédure récursive
hauteurshape = 30
largeurshape = 150
colonne = colonne + 1
forga.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, largeurshape, hauteurshape).Name = parent
forga.Shapes(parent).Line.ForeColor.SchemeColor = 22
txt = parent & " : " & Attribut & vbLf & attribut2
With forga.Shapes(parent)
.TextFrame.Characters.Text = txt
.TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
.TextFrame.Characters(Start:=1, Length:=Len(Attribut)).Font.Bold = True
.TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.ColorIndex = 3
.Fill.ForeColor.RGB = RGB(58, 95, 205)
End With
forga.Shapes(parent).Left = débutOrg.Left + niv * inth
forga.Shapes(parent).Top = débutOrg.Top + intv * colonne
For i = 1 To n
If Tbl(i, 1) = parent And niv > 1 Then
je n'arrive pas a rajouter dans Mon synoptique les elements de la colone n°3
ci dessous mon code
Dim colonne, débutOrg, forga, inth, intv, Tbl(), n
Sub DessineOrga()
Set forga = Sheets("SYNOP ELEC")
Set f = Sheets("BD ELEC")
Set débutOrg = forga.Range("a1")
Tbl = f.Range("A2" & f.[A65000].End(xlUp).Row).Value
n = UBound(Tbl)
For i = 2 To n
If InStr(Tbl(i, 1), ".") = 0 Then Tbl(i, 4) = "0" Else p = InStrRev(Tbl(i, 1), "."): Tbl(i, 4) = Left(Tbl(i, 1), p - 1)
Next i
For Each s In forga.Shapes
If s.Type = 17 Or s.Type = 1 Then s.Delete
Next
colonne = 0
inth = 90
intv = 40
créeShape Tbl(1, 1), 1, Tbl(1, 2), Tbl(1, 3)
End Sub
Sub créeShape(parent, niv, Attribut, attribut2) ' procédure récursive
hauteurshape = 30
largeurshape = 150
colonne = colonne + 1
forga.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, largeurshape, hauteurshape).Name = parent
forga.Shapes(parent).Line.ForeColor.SchemeColor = 22
txt = parent & " : " & Attribut & vbLf & attribut2
With forga.Shapes(parent)
.TextFrame.Characters.Text = txt
.TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 8
.TextFrame.Characters(Start:=1, Length:=Len(Attribut)).Font.Bold = True
.TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.ColorIndex = 3
.Fill.ForeColor.RGB = RGB(58, 95, 205)
End With
forga.Shapes(parent).Left = débutOrg.Left + niv * inth
forga.Shapes(parent).Top = débutOrg.Top + intv * colonne
For i = 1 To n
If Tbl(i, 1) = parent And niv > 1 Then