VBA add textbox to shapes

Doflamingo

Board Regular
Joined
Apr 16, 2019
Messages
234
Dear all, I'm trying to find a way to add textbox to shape created by the code below

Code:
Sub créeShape(parent, niv, Attribut, coul) 
  hauteurshape = 48
  largeurshape = 92
  colonne = colonne + 1
  forga.Shapes.AddShape(msoShapeRectangle, 10, 10, largeurshape, hauteurshape).Name = parent
  forga.Shapes(parent).Line.ForeColor.SchemeColor = 0
  txt = parent & vbLf & Attribut
  With forga.Shapes(parent)
    .AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50).TextFrame.Characters.Text = "txt"
    .TextFrame.Characters.Text = txt
    .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 10
    .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.ColorIndex = 1
    .Fill.ForeColor.RGB = coul


  End With
  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 = 0
      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), f.Cells(i + 1, 1).Interior.Color
  Next i
End Sub
But here the line in red I have added and it does not work, any ideas ?


Code:
Sub créeShape(parent, niv, Attribut, coul) 
  hauteurshape = 48
  largeurshape = 92
  colonne = colonne + 1
  forga.Shapes.AddShape(msoShapeRectangle, 10, 10, largeurshape, hauteurshape).Name = parent
  forga.Shapes(parent).Line.ForeColor.SchemeColor = 0
 [COLOR=#ff0000] txt = parent & vbLf & Attribut[/COLOR]


  With forga.Shapes(parent)
[COLOR=#ff0000]    .AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50).TextFrame.Characters.Text = "txt"[/COLOR]
    .TextFrame.Characters.Text = txt
    .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 10
    .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
    .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.ColorIndex = 1
    .Fill.ForeColor.RGB = coul


  End With
  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 = 0
      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), f.Cells(i + 1, 1).Interior.Color
  Next i
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,856
Office Version
2007
Platform
Windows
Try this

Code:
Sub créeShape(parent, niv, Attribut, coul)
    hauteurshape = 48
    largeurshape = 92
    colonne = colonne + 1
    With forga.Shapes
        .AddShape(msoShapeRectangle, 10, 10, largeurshape, hauteurshape).Name = parent
        forga.Shapes(parent).Line.ForeColor.SchemeColor = 0
        txt = parent & vbLf & Attribut
[COLOR=#ff0000]        boxName = "txt" & parent[/COLOR]
        .AddTextbox(msoTextOrientationHorizontal, 12, 12, largeurshape - 4, hauteurshape - 4).Name = [COLOR=#ff0000]boxName[/COLOR]
        With forga.Shapes([COLOR=#ff0000]boxName[/COLOR])
            .TextFrame.Characters.Text = txt
            .TextFrame.Characters(Start:=1, Length:=1000).Font.Size = 10
            .TextFrame.Characters(Start:=1, Length:=1000).Font.ColorIndex = 0
            .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.Bold = True
            .TextFrame.Characters(Start:=1, Length:=Len(parent)).Font.ColorIndex = 1
            .Fill.ForeColor.RGB = coul
        End With
    End With
    
[COLOR=#0000ff]    'Move form and textbox[/COLOR]
    forga.Shapes(parent).Left = débutOrg.Left + inth * colonne
    forga.Shapes(parent).Top = débutOrg.Top + intv * (niv - 1)
    
    forga.Shapes([COLOR=#ff0000]boxName[/COLOR]).Left = débutOrg.Left + inth * colonne [COLOR=#ff0000]+ 2[/COLOR]
    forga.Shapes([COLOR=#ff0000]boxName[/COLOR]).Top = débutOrg.Top + intv * (niv - 1) [COLOR=#ff0000]+ 2[/COLOR]
    
End Sub
 

Forum statistics

Threads
1,078,275
Messages
5,339,223
Members
399,286
Latest member
ossa

Some videos you may like

This Week's Hot Topics

Top