I have created a document for work. Due to security on the company computers the macro I have on the document is not automatically enabled.
I added directions on Page 1 for how to enable it. Now when someone prints, it prints this instruction page.
I tried to simulate a macro similar to the original one I used below, for not printing Blank Content Control, to print my instruction page as blank however, this was not effective.
Sub PrintReport()
Dim cc As ContentControl
For Each cc In ThisDocument.ContentControls
If Left(cc.Range.Text, 19) = "Click here to enter" Then
cc.Range.Font.ColorIndex = wdWhite
End If
Next
ActiveDocument.PrintOut
For Each cc In ThisDocument.ContentControls
If Left(cc.Range.Text, 19) = "Click here to enter" Then
cc.Range.Font.ColorIndex = 15
End If
Next
End Sub
I also tried to create a macro, using assistance from this site, to only print specific pages (ie. 2-5). This did not work.
Sub SpecialPgOnePrint()
Application.PrintOut FileName:="Visitation Report (Fillable-Final)", _
Range:=wdPrintRangeOfPages, Pages:="2-5"
End Sub
I would appreciate help identifying a way to either A. not print page1 (preferable) or B. start printing at page2
Try the following
Option Explicit
Sub PagePrint()
With ActiveDocument
.PrintOut Range:=wdPrintFromTo, _
From:=Format(.Sections(1).Headers(1).PageNumbers.StartingNumber + 2), _
To:=Format(.Range.Information(wdActiveEndAdjustedPageNumber))
End With
End Sub
Related
i have 5 pages in multipage userform.
if the next button enabled, which it can be clicked by user then it should move to next hidden page, i always got an error "Object Required" it drives me crazy.
Private Sub btnGenerate_Click()
iPageNo = MultiPage1.Value + 1
MultiPage1.Pages(iPageNo).Visible = True
MultiPage1.Value = iPageNo
End Sub
that code seems doesnt work for me, any help would be appreciate.
Thanks
Which line is causing the error when you step thru?
Ensure there are enough existing pages. Also, has the name of the MultiPage object changed?
This code below tested working (2 Pages in MultiPage1, Page2 set hidden):
Option Explicit
Private Sub CommandButton1_Click()
Dim iNextPage As Long
With Me.MultiPage1
iNextPage = .Value + 1
If iNextPage < .Pages.Count Then
.Pages(iNextPage).Visible = True
.Value = iNextPage
End If
End With
End Sub
I have a custom template that I built in Word.
I used Content controls for certain fill-able fields and used 'Restrict editing' - 'No changes' with exceptions (the content controls) to protect it.
After the user fills out the content control information, they click a "Reset" button to start over. The code associated with this button is below.
Question is: How do I re-protect the doc with the original protection parameters I put in place?
Thank you for your help!
JP
Private Sub CommandButton21_Click()
ActiveDocument.Unprotect ("Word")
Dim oCC As ContentControl
x = 1
For Each oCC In ActiveDocument.ContentControls
Count = x
If Count > 0 Then
oCC.Range.Text = ""
End If
x = x + 1
Next oCC
ActiveDocument.Protect wdNoProtection, , "Word"
End Sub
Recently I have been struggling with publisher at work, and the most recent source of concern is the software inability to give something a simple as an auto-updating "total pages" count.
I decided to look into macros for a solution, but with my limited knowledge of VBA I only managed to get so fat before hitting a roadblock.
I want to create a macro that automatically starts when the document is opened and as frequently as possible updates a textbox in the master page.
The textbox should show "page X of Y", but due to publisher limitations only the "X" is automatically updated without using a macro.
What I have right now:
Private WithEvents PubApp As Publisher.Application
Private Sub Document_Open()
Set PubApp = Publisher.Application
End Sub
Private Sub PubApp_WindowPageChange(ByVal Vw As View)
MsgBox "Your publication contains " & _
ActiveDocument.Pages.Count & " page(s)."
End Sub
The macro automatically starts when the document is opened and creates a popup with the total page number every time the user changes page.
So, I accomplished the first half of my goal, but I need some help with the rest.
Here's a working macro for anyone with the same problems
Private WithEvents PubApp As Publisher.Application
Private Sub Document_Open()
Set PubApp = Publisher.Application
End Sub
Private Sub PubApp_WindowPageChange(ByVal Vw As View)
Dim mp As MasterPages
Set mp = ActiveDocument.MasterPages
With mp.Item(1)
.Shapes(19).TextFrame.TextRange.Text = ""
.Shapes(19).TextFrame.TextRange.InsertPageNumber
.Shapes(19).TextFrame.TextRange.InsertBefore _
NewText:="Page "
If ActiveDocument.Pages.Count > 9 Then
.Shapes(19).TextFrame.TextRange.InsertAfter _
NewText:=" of " & _
ActiveDocument.Pages.Count
Else
.Shapes(19).TextFrame.TextRange.InsertAfter _
NewText:=" of 0" & _
ActiveDocument.Pages.Count
End If
End With
End Sub
X In mp.Item(X) identifies your master page (in case you have more than one).
Y in Shapes(Y) identifies the target text box.
The macro runs in background without the need of active input and refreshes the content of the target text box on every page change.
Since the automatic page numbering format used in the document is "01, 02, 03 ... 11, 12 13" I included an If selection to add a 0 before the total page count if said number is lower than 10.
I'm sure there are more elegant ways of solving this problems, but hey, at least it works.
Here is a clarification for anyone else trying to research the limited information on programmatically changing the header or footer in the master pages using VBA in Publisher. This tip also includes a clarification of how to Add Text To the Left,Center,Right portions of the header:
All the credit goes to M.Baroni
Function FixHeader1()
Dim mp As MasterPages
Set mp = ActiveDocument.MasterPages
With mp.Item(1)
.Header.TextRange.text = "My Publication" & vbTab
.Header.TextRange.InsertPageNumber
.Header.TextRange.InsertAfter NewText:=vbTab & MonthName(Month(Date)) & " " & Year(Date)
End With
End Function
The problem I have got is that my corporate template set uses a SaveDate field in the footer of every word document - which is used to detail when the document was saved, which ties in with our custom document management system.
Subsequently, when users want to make a PDF of an old document, using the Save As PDF function of Office 2010, the Save Date is updated - creating a PDF of the old document, but with today's date. This is wrong. We are just trying to create a true PDF version of whatever the original document has in it.
To get around this, I am writing a macro solution which locks the fields, exports the document as a PDF and then unlocks the fields again.
I have come up against an issue where I can identify and lock all fields in the headers/footers (which is actually what I'm trying to do) but to make it more robust, need to find out a way to lock ALL FIELDS in ALL SECTIONS.
Showing you my code below, how can I identify all fields in all sections? Will this have to be done using the Index facility?
Sub CPE_CustomPDFExport()
'20-02-2013
'The function of this script is to export a PDF of the active document WITHOUT updating the fields.
'This is to create a PDF of the document as it appears - to get around Microsoft Word 2010's native behaviour.
'Route errors to the correct label
'On Error GoTo errHandler
'This sub does the following:
' -1- Locks all fields in the specified ranges of the document.
' -2- Exports the document as a PDF with various arguments.
' -3- Unlocks all fields in the specified ranges again.
' -4- Opens up the PDF file to show the user that the PDF has been generated.
'Lock document fields
Call CPE_LockFields
'Export as PDF and open afterwards
Call CPE_ExportAsPDF
'Unlock document fields
Call CPE_UnlockFields
'errHandler:
' MsgBox "Error" & Str(Err) & ": " &
End Sub
Sub CPE_LockFields()
'Update MS Word status bar
Application.StatusBar = "Saving document as PDF. Please wait..."
'Update MS Word status bar
Application.StatusBar = "Locking fields in all section of the active document..."
'Declare a variable we can use to iterate through sections of the active document
Dim docSec As section
'Loop through all document sections and lock fields in the specified ranges
For Each docSec In ActiveDocument.Sections
docSec.Footers(wdHeaderFooterFirstPage).Range.fields.Locked = True
docSec.Footers(wdHeaderFooterPrimary).Range.fields.Locked = True
docSec.Footers(wdHeaderFooterEvenPages).Range.fields.Locked = True
Next
End Sub
Sub CPE_UnlockFields()
'Update MS Word status bar
Application.StatusBar = "PDF saved to DocMan Temp. Now unlocking fields in active document. Please wait..."
'Declare a variable we can use to iterate through sections of the active document
Dim docSec As section
'Loop through all document sections and unlock fields in the specified ranges
For Each docSec In ActiveDocument.Sections
docSec.Footers(wdHeaderFooterFirstPage).Range.fields.Locked = False
docSec.Footers(wdHeaderFooterPrimary).Range.fields.Locked = False
docSec.Footers(wdHeaderFooterEvenPages).Range.fields.Locked = False
Next
End Sub
Sub CPE_ExportAsPDF()
'Update MS Word status bar
Application.StatusBar = "Saving document as PDF. Please wait..."
'Chop up the filename so that we can remove the file extension (identified by everything right of the first dot)
Dim adFilename As String
adFilename = Left(ActiveDocument.FullName, (InStrRev(ActiveDocument.FullName, ".", -1, vbTextCompare) - 1)) & ".pdf"
'Export to PDF with various arguments (here we specify file name, opening after export and exporting with bookmarks)
With ActiveDocument
.ExportAsFixedFormat outPutFileName:=adFilename, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, _
OptimizeFor:=wdExportOptimizeForPrint, Range:=wdExportAllDocument, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateWordBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End With
'Update MS Word status bar
Application.StatusBar = "PDF saved to DocMan Temp."
End Sub
Try something like the following to get to all fields in the document, header, footer, background and main text:
Sub LockAllFieldsInDocument(poDoc As Document, Optional pbLock As Boolean = True)
Dim oRange As Range
If Not poDoc Is Nothing Then
For Each oRange In poDoc.StoryRanges
oRange.Fields.Locked = pbLock
Next
End If
Set oRange = Nothing
End Sub
Here is another way to do it. It'll select the entire document and then lock all fields, before deselecting everything.
Sub SelectUnlink()
ActiveDocument.Range(0, 0).Select
Selection.WholeStory
Selection.Range.Fields.Unlink
Selection.End = Selection.Start
End Sub
Trying to print the same excel sheet a number of times (e.g 100) with a cell incremented each time (e.g cell 4F).
I tried using
Workbook_BeforePrint
to increment the cell, but it requires interaction with the "select printer" dialog for each printed sheet.
Would it be possible to make something like:
a = getIntegerUserInput()
for i in 1..a
increment 4F with one
print the sheet suppressing the "select printer" dialog
end for
Cheers
Have you selected a default printer?
I used this:
Sub printinc()
For i = 0 To 3
Range("A1").Value = Range("A1").Value + 1
Sheets("Sheet1").PrintOut
Next
End Sub
It printed 4 copies incrementing the value in cell A1 each time without prompting me for settings or printer selection.
To print a sheet, you can use this kind of code (assuming you know on which printer you want to print) using PrintOut:
Sub PrintFile()
Dim curPrinter As String
curPrinter = Application.ActivePrinter
Application.ActivePrinter = "Myprinter"
ActiveWindow.SelectedSheets.PrintOut
Application.ActivePrinter = curPrinter
End Sub
Hence, you can create a loop to increase a cell and print your worksheet with the increment.
By the way, you could do it using Before_print and if you don't want to display the print dialog, you can set Cancel to False while calling the procedure Private Sub Workbook_BeforePrint( Cancel As Boolean) (ref on MSDN)
You can also read this SO thread to prevent displaying the printing dialog: How do you prevent printing dialog when using Excel PrintOut method.
[EDIT] see Seyren's answer for a working solution on what you want. Yet, take care about the performance if you really wanted to loop 100 times.
Private Sub Workbook_BeforePrint(Cancel As Boolean)
'//supress recursion into this event when we print
Application.EnableEvents = False
'//increment
If Not IsNumeric(ActiveSheet.Range("A1").Value) Then ActiveSheet.Range("A1").Value = 0
ActiveSheet.Range("A1").Value = ActiveSheet.Range("A1").Value + 1
'//do a default print
ActiveSheet.PrintOut
Application.EnableEvents = True
'//prevent the default print
Cancel = True
End Sub