Insert Text Box

[vmjan02]

I have this code, and is working all fine, but I am not sure as how to add more text box, I mean the code should add 30 text box.
Currently it is adding on 1 textbox. Any idea.

Sub DrawTextbox()
    Dim ws As Worksheet, s As Shape
    Set ws = ActiveSheet
    ActiveWindow.SmallScroll up:=26
    ActiveWindow.SmallScroll Down:=26
    
    ' Create label (height/width will be set by AutoSize).
    Set s = ws.Shapes.AddShape(msoShapeRectangularCallout, 12.5, 723.75, 80, 46.25)
    's.IncrementRotation 180
    s.Adjustments.Item(1) = -0.46355
    s.Adjustments.Item(2) = -1.39427
    s.TextFrame.Characters.Text = Sheets("Tables").Range("c5") '"This is some label text"
   ' s.TextFrame.AutoSize = True
    
    With s.TextFrame2.TextRange.Font.Fill
         .ForeColor.RGB = RGB(0, 0, 0)
    End With
  
   s.Select
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .Weight = 0.75
        .Transparency = 0
        .ForeColor.RGB = RGB(0, 0, 0)
    End With
    
    Selection.ShapeRange.Fill.Visible = msoFalse



'    With Selection.ShapeRange.Line
'        .Visible = msoTrue
'        .ForeColor.RGB = RGB(0, 0, 0)
'        .Transparency = 0
'    End With
End Sub

 

[KOKOSEK]

For i=1 to 10
' macro from 'create lable
'somewhere in the middle
s.Name="MySpeechOutNumber"&i
' before End Sub
Next i

 

[vmjan02]

cool. done.
working fine.

If i want to give the condition , like if the cells are blank then don't create a text box, but if the cell value is not blank then create the text box with that value.

 

[KOKOSEK]

so instead of

For i=...
Next i

you can do something like:

dim cell as Range
for each cell in range("C1:C10")  'as I see text inside object is from col. C
  if cell.value<>"" then
     ' you main part of macro which create object
 end if
next cell

 

[vmjan02]

ok, great. its working