VBA: Run-Time error '91: Object variable or with block variable not set

[visio2025]

I recorded a macro and this error keeps coming up when I run it.  They highlight "ActiveWindow.SelectedText.Paste" under " vsoCharacters2.Begin = 5
    vsoCharacters2.End = 13
    ActiveWindow.SelectedText = vsoCharacters2"

Anyone know what I'm doing wrong or should modify? I'm copying a few objects(including text boxes) and then copying text from one excel workbook then pasting it in the text boxes.

Code Select Expand

Sub start()
' Keyboard Shortcut: Ctrl+q
'

    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140

    Application.ActiveWindow.DeselectAll

    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Duplicate")
    ActiveWindow.DeselectAll
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1851), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1850), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1862), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1861), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1885), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1886), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1887), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1888), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1889), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1890), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(76), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(71), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1872), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1873), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1874), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1875), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1876), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1877), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(70), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(69), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1860), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1852), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1868), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1863), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1854), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1865), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1879), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1880), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1882), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1883), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1884), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(74), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1881), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(73), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1855), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1866), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1878), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(72), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1853), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1864), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1857), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1869), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1893), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1894), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1848), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1849), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1859), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1892), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1847), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1858), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1870), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1871), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1891), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(75), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1856), visSelect
    ActiveWindow.Select Application.ActiveWindow.page.Shapes.ItemFromID(1867), visSelect
    Application.ActiveWindow.Selection.Duplicate
    Application.ActiveWindow.Selection.Move 5.898594, 0.51
    Application.EndUndoScope UndoScopeID1, True

    Application.ActiveWindow.SetViewRect -2.693333, 10.206667, 10.44, 4.513333

    Application.ActiveWindow.SetViewRect -1.04, 9.59, 7.83, 3.385

    Application.ActiveWindow.SetViewRect -0.052, 9.22, 6.264, 2.708

    Application.ActiveWindow.SetViewRect 1.4275, 8.665, 3.915, 1.6925

    Application.ActiveWindow.SetViewRect 2.25, 8.356667, 2.61, 1.128333

    Application.ActiveWindow.SetViewRect 1.615, 8.5975, 3.915, 1.6925

    Application.ActiveWindow.SetViewRect 0.472, 9.032, 6.264, 2.708

    Application.ActiveWindow.SetViewRect -0.29, 9.325, 7.83, 3.385

    Application.ActiveWindow.page = Application.ActiveDocument.Pages.ItemU("Point List")

    Application.ActiveWindow.page = Application.ActiveDocument.Pages.ItemU("Flow Diagram")

    Dim vsoCharacters2 As Visio.Characters
    Set vsoCharacters2 = Application.ActiveWindow.page.Shapes.ItemFromID(2948).Characters
    vsoCharacters2.Begin = 5
    vsoCharacters2.End = 13
    ActiveWindow.SelectedText = vsoCharacters2
    ActiveWindow.SelectedText.Paste

    Dim vsoCharacters3 As Visio.Characters
    Set vsoCharacters3 = Application.ActiveWindow.page.Shapes.ItemFromID(2902).Characters
    vsoCharacters3.Begin = 6
    vsoCharacters3.End = 14
    ActiveWindow.SelectedText = vsoCharacters3
    ActiveWindow.SelectedText.Paste

    Dim vsoCharacters4 As Visio.Characters
    Set vsoCharacters4 = Application.ActiveWindow.page.Shapes.ItemFromID(2913).Characters
    vsoCharacters4.Begin = 5
    vsoCharacters4.End = 13
    ActiveWindow.SelectedText = vsoCharacters4
    ActiveWindow.SelectedText.Paste

    Dim vsoCharacters5 As Visio.Characters
    Set vsoCharacters5 = Application.ActiveWindow.page.Shapes.ItemFromID(2924).Characters
    vsoCharacters5.Begin = 5
    vsoCharacters5.End = 13
    ActiveWindow.SelectedText = vsoCharacters5
    ActiveWindow.SelectedText.Paste

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub

[Surrogate]

do you really have selected text ?

[wapperdude]

It would help if you would describe what you're trying to do.

Your code only works if the actual text to replace is selected as Surrogate indicates.  A slight change overcomes this:

Code Select Expand


Sub TxtPaste()

    Dim vsoCharacters1 As Visio.Characters
    Dim vsoCharacters2 As Visio.Characters

    Set vsoCharacters1 = Application.ActiveWindow.Page.Shapes.ItemFromID(1).Characters  'This establishes the text to be copied
    vsoCharacters1.Begin = 8
    vsoCharacters1.End = 14
    vsoCharacters1.Copy

    Set vsoCharacters2 = Application.ActiveWindow.Page.Shapes.ItemFromID(1).Characters  'This establishes the target for pasting the text
    vsoCharacters2.Begin = 24
    vsoCharacters2.End = 31
    vsoCharacters2.Paste

End Sub

The other issue, which isn't getting an error flag is that it seems like you're pasting the results to same location that you copied from.  You've not established a new target for the pasting.

Wapperdude

[wapperdude]

A variant to the code above makes the selected shape the active shape.  Then the paste text works:

Code Select Expand


Sub TxtPaste()

    Dim vsoCharacters1 As Visio.Characters
    Dim vsoCharacters2 As Visio.Characters
    Dim vsoShp as Shape
   
    Set vsoCharacters1 = ActiveWindow.Page.Shapes.ItemFromID(1).Characters  'This is text to be copied
    vsoCharacters1.Begin = 8
    vsoCharacters1.End = 14
    vsoCharacters1.Copy

    Set vsoShp = ActivePage.Shapes.ItemFromID(1)
    ActiveWindow.Select vsoShp, visSelect   'This makes the shape ACTIVE

    Set vsoCharacters2 = ActiveWindow.Page.Shapes.ItemFromID(1).Characters  'This establishes the target for pasting the text
    vsoCharacters2.Begin = 24
    vsoCharacters2.End = 31
    ActiveWindow.SelectedText = vsoCharacters2   'This makes the text ACTIVE
    ActiveWindow.SelectedText.Paste

End Sub