[Solved] Create new page with VBA, but stop if named the same

Started by SubPlanner, December 18, 2015, 02:06:14 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

SubPlanner

I have some vba code that creates a new page for me and names it "New Blank". I created this from a recorded macro and it works well. I launch this from a button.
My dilemma is, I want to add in a safeguard that will stop the user from creating another page with the same name.

I figured it would be:
If PageName = "New Blank" then
MsgBox "Page already exists. Rename old page and start again"
else
endif


Any help would be appreciated with this issue.

SubPlanner

Surrogate

May be something like as ?
Sub rt()
Dim pg As Page
If ActiveDocument.Pages("New blank").ObjectType = 14 Then
ActiveDocument.Pages("New blank").Name = "Old Blank"
End If
Set pg = ActiveDocument.Pages.Add
pg.Name = "New blank"
End Sub

SubPlanner

That seamed to work well, now the other dilemma.
The code crashes when it cant find a document named "New Blank"  ???

SubPlanner

Yacine

dim pg as page

set pg = getPageByName("New Blank")

if not pg is nothing then
  if pg.objecttype = 14 then ...

Function getPageByName(PageName as string) as page
dim pg as page
for each pg in activedocument.pages
  if pg.name = PageName then
    set getPageByName = pg
   endif
   exit function
next pg
end function
Yacine

SubPlanner

Thanks Yacine

Should your section of code be added to the code provided by Surrogate?

SubPlanner

Yacine

Yes, it was ment to be an amendment to Surrogate's code.
Sorry to have been so short.
It actually shows how you can catch an error like the one you encountered.
Set the critical code in a separate function that gives back a value if everything is fine or nothing (or boolean false) if something wrong happens.
With some appropriate error catching, you can even let the sub-routine crash, but still have your main routine working as expected.
Regards,
Y.
Yacine

SubPlanner

Sorry Yacine, I can't get your part of the code to work with Surrogates part.

I am attempting various mixtures of both codes but I can't get it to work.  :'(

SubPlanner

Yacine

#7
As short as the first one  ;) .
Sub rt()
Dim pg As Page

set pg = getPageByName("New Blank")

if not pg is nothing then
  if pg.objecttype = 14 then
     pg.Name = "Old Blank"
  ENDIF
End If
Set pg = ActiveDocument.Pages.Add
pg.Name = "New blank"
End Sub

Function getPageByName(PageName as string) as page
dim pg as page
for each pg in activedocument.pages
  if pg.name = PageName then
      set getPageByName = pg
      exit function
   endif
next pg
end function
Yacine

SubPlanner

Yacine, Your code does work and it pops up this message (see .png) that notifies the user that the "New Blank" already exists. And that is a good thing.
But,
It still creates a new page, it just gives it a different page number in sequence like "Page-5" or "Page-6".

I was trying to insert another "IF" statement with an "OK" style message box that will halt the process if there is a page named "New Blank" and not let it create any other pages until they change that name to something else.

Thanks for your patience working with me on this.

SubPlanner.

Yacine

Hi Subplanner,
I would spoil you too much if I gave you the code for your last question.

You've now a new tool at hand - the function getPageByName - and you know how it behaves when there is and when there isn't such page.
You do also know from the code how to ask if the page was found.
A second variable pg2, may help.

Cheers,
Y.
Yacine

SubPlanner

HHmmmm,

Thanks for the code you have given me so far.
After 15 years of programming SQL and VBA in Access, you would think I could handle this.
I will get it sooner or later.

I will attempt to be the person my dog thinks I am.

SubPlanner

wapperdude

#11
 If you go to the code window, and then use <F8> to step thru the code, you can see what happens line by line.  Tile the code window and drawing window to be side by side and you can watch what happens.

Couple of observations I made:
1.)  The string "New Blank" should be "New blank".  Previous code has a typo.  This causes page name comparison to fail and improper code execution.  Note also, when Visio names the page, "New Blank" becomes "New blank".   >:(  Not a good feature in this case.   :o
2.)  Correcting the code, expected execution determines if "New blank" exists then it gets renamed "Old blank".  But, subsequent running of macro, will produce error that "Old blank" already exists.  Seems "Old blank" just delays the inevitable, since it too, must be renamed.   :P
3.)  Rather than renaming, I modified the code to splash a Msg Box, and then subsequently bail-out of macro.  ::)
4.)  Modified Yacine's function, such that the "pg" variable is always set with a value.  That makes the first "IF" test unnecessary.   :o

Sub rt()
    Dim pg As Page
   
    Set pg = getPageByName("New blank")
   
'With modification to Yacine's function, this following test is unnecessary.
    'If Not pg Is Nothing Then
    '  If pg.ObjectType = 14 Then
    '     pg.Name = "Old blank"
    '  End If
    'End If
   
    If pg.Name = "New blank" Then  'Check for "New blank" existing, bail-out
        MsgBox "'New blank' already exists. Re-name and re-run."
        Exit Sub
    '    pg.Name = "Old blank" 'Could use this line instead of previous 2 lines.
    ' but there is a problem in "Old blank" exists.
    End If
   
    Set pg = ActiveDocument.Pages.Add
    pg.Name = "New blank"
End Sub

Function getPageByName(PageName As String) As Page
    Dim pg As Page
    For Each pg In ActiveDocument.Pages 'Modified "For" loop, so pg always gets a value
        If pg.Name = PageName Then  'Visio names page with no 2nd capital, test would fail.
            Set getPageByName = pg
            Exit Function
        Else
            Set getPageByName = pg
        End If
    Next pg
End Function


HTH
Wapperdude
Visio 2019 Pro

SubPlanner

Thanks for kicking in wapperdude.
But in the usual fashion, I just got what I needed a few minutes before you posted your code.

Here's what I have.
A tab for updating info with a launch button to create a new page.
I also have a text box for folks to enter a new name for the new page thy are going to create.
If the text box is blank, the code will tell them to enter a name.
If they use the same name, the code will tell them the name already exists.

Here is the code.
Private Sub CreateNewPage_Click()
If Me.NewTabName = "" Then
MsgBox "Need a Name.", vbOKOnly + vbInformation, "Page Detector"

ElseIf Me.NewTabName > "" Then
Call newPage1
End If
End Sub

Function newPage1()
   Dim vsoPage1 As Visio.Page
   Dim pg As Page
   For Each pg In ActiveDocument.Pages
If pg.Name = Me.NewTabName Then
MsgBox "Named same as exsiting page.", vbOKOnly + vbInformation, "Page Detector"
Exit Function
End If
Next pg
Call newPage2
End Function

Function newPage2()
   Dim vsoPage1 As Visio.Page
   Dim pg As Page
Set vsoPage1 = ActiveDocument.Pages.Add
   vsoPage1.Name = Me.NewTabName
   Application.ActivePage.BackPage = "Template"
   Me.NewTabName = ""
End Function


Again, I appreciate your input with this item.

SubPlanner

Yacine

Sorry Wayne to disagree with you.
In your code, if the name does not exist, then pg is always the last in the pages collection.
This is not what we want. We rather want to be warned, that it doesn't exist and we know it, when "pg is nothing".

The issue with upper and lower case can easily be solved by the condition:
if LCASE(pg.name) = LCASE(PageName)

Cheers,
Y.
Yacine

SubPlanner

Thanks for not spoiling me Yacine.     8)


Subplanner

Browser ID: smf (is_webkit)
Templates: 4: index (default), Display (default), GenericControls (default), GenericControls (default).
Sub templates: 6: init, html_above, body_above, main, body_below, html_below.
Language files: 4: index+Modifications.english (default), Post.english (default), Editor.english (default), Drafts.english (default).
Style sheets: 4: index.css, attachments.css, jquery.sceditor.css, responsive.css.
Hooks called: 412 (show)
Files included: 34 - 1321KB. (show)
Memory used: 1281KB.
Tokens: post-login.
Cache hits: 12: 0.00226s for 26,572 bytes (show)
Cache misses: 2: (show)
Queries used: 13.

[Show Queries]