Renaming Tab based on object Value

Started by migseye, April 19, 2017, 09:19:34 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

migseye

Hey guys, I was able to create a function for 2013 users that would duplicate the page, rename a tab based on a configuration generated by the userform and then return to the first page and reinitialize the userform.  It is below.  I found out 2010 users do not have the duplicate page function.  I found good code to copy pages in 2010 but when I try to apply my code for pulling the name I am hit with all kinds of errors like object errors.  Below are both working codes, the second does now have any page renaming features that I would like help adding.  Bonus points if only visible layers are copied.


Working code for 2013 with page rename:

Sub DupPage()
' Keyboard Shortcut: Ctrl+d
'

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

    Dim UndoScopeID1 As Long
    UndoScopeID1 = Application.BeginUndoScope("Duplicate Page")
    Application.ActiveDocument.Pages.ItemU("Layers").Duplicate
    Application.EndUndoScope UndoScopeID1, True

    ActiveWindow.DeselectAll
    ActiveWindow.Select Application.ActiveWindow.Page.Shapes.ItemFromID(1345), visSelect
    Application.ActiveWindow.Selection.Copy

    Application.ActivePage.Name = Application.ActiveWindow.Page.Shapes.ItemFromID(1345).Characters
    Application.ActiveWindow.Page = Application.ActiveDocument.Pages.ItemU("Layers")
    PlatformOptions.Show
   
    Dim vsoCharacters1 As Visio.Characters


   
   
   
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub


The code below works for 2010 user to copy page but does not rename.  This is not mine, I found it online. It requires the string to be defined outside the Sub:


                TabLabel As String

Public Sub CopyToNewPage()


   
    Dim vsoSelection As Visio.Selection
   
    'Make sure we are in a drawing window
    If Application.ActiveWindow.Type = Visio.VisWinTypes.visDrawing Then
   
        'If there is no selection, select all shapes on the page
        Set vsoSelection = Application.ActiveWindow.Selection
        vsoSelection.IterationMode = 0
        If vsoSelection.Count = 0 Then
            vsoSelection.SelectAll
        End If
       
        'Copy selection to new page
        vsoSelection.Copy Visio.visCopyPasteNoTranslate
        Application.ActiveDocument.Pages.Add
        Application.ActivePage.Paste Visio.visCopyPasteNoTranslate
         Application.ActiveWindow.Page = Application.ActiveDocument.Pages.ItemU("Layers")
    End If

End Sub

Yacine

It would help if you tell which line gives an error and what the error is.
Yacine