VBA assists with Shapes and text inside

[icecurtain]

FULL CODE

Sub AddTextBoxes1()
    ' Get a reference to the shapes collection

    Dim workingShapes
    Set workingShapes = Application.ActivePresentation.Slides(1).Shapes
    
    ' Prepare the working variables for getting the text box values
    Dim valuesFileName As String
    valuesFileName = "C:\words.txt"
    Dim valuesFile As Integer
    Dim values() As String
    Dim line As String
    Dim lineLength As Long
    Dim currentUpperBound As Long
    currentUpperBound = -1
    
    ' Get the list of text box values
    valuesFile = FreeFile
    Open valuesFileName For Input As valuesFile
    Do While Not EOF(valuesFile)
        Line Input #valuesFile, line
        lineLength = Len(line)
        If lineLength > 0 Then
            currentUpperBound = currentUpperBound + 1
            ReDim Preserve values(0 To currentUpperBound)
            values(currentUpperBound) = line
        End If
    Loop
    Close #valuesFile
    MsgBox ("Found " & (currentUpperBound + 1) & " values")
    
    ' Prepare the working variables for creating the text boxes
    Dim counter, left, top, width, height, offsetLeft, offsetTop As Integer
    Dim workingShape
    Dim value As String
    left = 10
    top = 10
    width = 200
    height = 50
    offsetLeft = 0
    offsetTop = 50
    
    ' Create the shape boxes
    counter = 0
    Do Until counter > currentUpperBound
        value = values(counter)
   Set workingShape = workingShapes.AddShape(msoShapeRectangle, left, top, width, height).select
        Selection.workingShape.TextFrame.TextRange.Characters.Text = value
        'workingShape.TextFrame.TextRange.Text = value
        left = left + offsetLeft
        left = left + offsetLeft
        top = top + offsetTop
        counter = counter + 1
    Loop
End Sub
PROBLME AREA

 ' Create the shape boxes
    counter = 0
    Do Until counter > currentUpperBound
        value = values(counter)
         Set workingShape = workingShapes.AddShape(msoShapeRectangle, left, top, width, height)
   [B]        ' Selection.workingShape.TextFrame.TextRange.Characters.Text = value[/B]
        'workingShape.TextFrame.TextRange.Text = value
        left = left + offsetLeft
        left = left + offsetLeft
        top = top + offsetTop
        counter = counter + 1

this last bit is causing me a problem

I want to create a shapes the put text in to the shape.

I am using Power Point but the VBA should be the simular

the shapes are created fine if I remove the select and "Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = value" line but how can I get the text into the shapes? My VBA is on a steep learning curve and for some reason MS has remove the recorder for Power Point 2010.

 

[icecurtain]

I have managed to get text boxes over the shape but this is not what I want. I want text inside shape.

Set workingShape = workingShapes.AddShape(msoShapeRectangle, left, top, width, height)
workingShape.TextFrame.TextRange.Text = value

 

[icecurtain]

This work fine for Power point I am not trying Visio .

 

[laughingdevil]

I've got somthing similar in my current project, try this


xls.Shapes("dq_ovalfu").OLEFormat.Object.Text = "bob"

just change "dq_ovalfu" to the name of your shape, or the variable with its name stored in.

 

[icecurtain]

sorted it

 

[lmvk99]

Hi Guys,

I have a similar problem but none of these suggestions have worked for me. Its probably something silly, but I am working in excel 2007 and I have some pretty buttons that I grabbed from the ready made shapes. I added some text (these pre-made shapes seem to already have a text box imbedded somehow) and now I have written this code that is supposed to grab my template button, copy it, rename its object name, change the text displayed on it and reposition it. The bug is occurring on the line ".TextRange.Text = "New Button""...any suggestions?

Set othshape = myDocument.Shapes.Range("Template1")
othshape.Select
Selection.Copy
ActiveSheet.paste

With othshape
.Name = "New" & i
.TextRange.Text = "New Button"
.Top = l + 30 + (i - j) * 18
.Left = m + 3
End With

Next

Thanks so much!