Add page numbers to Draw/Impress not starting at page one

[JeJe]

Add a shape to the first page/slide with the first number you want for the page and suitable name such as "PgNo". Select this shape by the border and these subs will
-add similar shapes with numbering to the pages of the rest of the document
-renumber them after changing the order of the pages
-move them all to a matching position after moving the first shape
-delete the added shapes

Code: Select all

'Add a page number shape such as a rectangle with chosen first page number for the text 
'and suitable name eg "PgNo"
'similar shapes will be added to subsequent pages/slides with incrementing number till the end of the document
'with name PgNo1, PgNo2 etc
sub AddPageNumbers 
    Dim oPages, oSourcePage, oTargetPage, oShape, curpage,CharFontName,Charheight,nm,startpage as long
	dim oDoc
	odoc =thiscomponent     
    sh=odoc.currentselection.getbyindex(0)
    sz = sh.size
    ps = sh.position
    CharFontName=sh.text.CharFontName
    CharHeight = sh.text.CharHeight
    curpage = odoc.currentcontroller.currentpage.number -1
    nm = sh.name
   	startpage = val( sh.string)
   
   oPages = odoc.getDrawPages()
    For i = curpage+1 To oPages.getCount() - 1
    Shnew = odoc.createInstance( "com.sun.star.drawing.RectangleShape" )
   with shnew
   .position = ps
   .size = sz
   startpage = startpage + 1
   .name = nm & startpage
   
   .FillStyle = com.sun.star.drawing.FillStyle.NONE
   .LINEstyle = com.sun.star.drawing.LineStyle.NONE
     
        if i <> curpage then oPages.getByIndex(i).add(Shnew)
   .string = startpage
     with .text        
        .CharFontName=CharFontName
        .CharHeight = CharHeight
        end with
        .MoveProtect = true
        .SizeProtect = true
        end with
    Next i
    msgbox "Done"
end sub

'if you have reordered the pages run this sub so the page numbers are put back in sequence
Sub ReSetPageNumbers  'select first shape by border NOT text within
    Dim oPages, oSourcePage, oTargetPage, oShape, curpage,CharFontName,Charheight,nm,startpage as long
	odoc =thiscomponent     
    sh=odoc.currentselection.getbyindex(0)
    curpage = odoc.currentcontroller.currentpage.number -1
    nm = sh.name
    startpage = val( sh.string)
   
   oPages = odoc.getDrawPages()
    For i = curpage+1 To oPages.getCount() - 1
   
   oSourcePage=ThisComponent.drawpages(i)
   if oSourcePage.count>0 then
   for j= 0 to oSourcePage.count-1
'For Each oShape In oSourcePage
oshape = osourcepage.getbyindex(j)
if instr(oshape.name,nm)=1 then
startpage = startpage + 1
   oShape.string = startpage
   oShape.name = nm & startpage
exit for
end if
Next 
end if
next

    msgbox "Done"

end sub

'if you want to change the position of all the shapes 
'move the first shape to where desired, select by shape border NOT text within and run this sub
Sub ReSetPagePositions  
    Dim oPages, oSourcePage, oTargetPage, oShape, curpage,CharFontName,Charheight,nm,startpage as long,j as long
	odoc =thiscomponent     
    sh=odoc.currentselection.getbyindex(0)
   sz = sh.size
   ps = sh.position
    curpage = odoc.currentcontroller.currentpage.number -1
    nm = sh.name
    
   oPages = odoc.getDrawPages()
    For i = curpage+1 To oPages.getCount() - 1
   
   oSourcePage=ThisComponent.drawpages(i)
if oSourcePage.count>0 then
    for j = 0 to oSourcePage.count -1
    oshape = oSourcePage.getbyindex(j)
with oshape
if instr(1,.name,nm)=1 then
.size = sz 
.position = ps
end if
end with
Next 
end if
next
    msgbox "Done"
end sub

'To delete page number shapes
'select first shape by border NOT text within shape and run this sub
Sub DeleteSimilarNameShape()  
    dim st,sz,ps,opages,i as long,j as long, odrawpage,nm
if MsgBox("Do you want to continue?", vbQuestion + vbYesNo, "Confirmation") <> 6 then exit sub
    
    sh=thiscomponent.currentselection.getbyindex(0)
	nm =sh.name
    oPages = thiscomponent.getDrawPages()
    For i = 0 To opages.getCount() - 1
            odrawpage = opages.getByIndex(i)
        if  oDrawPage.Count>0 then
            For j = oDrawPage.Count - 1 To 0 Step -1
        if instr(1,oDrawPage.getByIndex(j).name,nm)=1 then
         oDrawPage.remove(oDrawPage.getByIndex(j))
         end if
    Next j
    end if
    Next i
msgbox "Done"
end sub