Thursday, September 8, 2011

Windows Vista Version


Note:
The following will work in Windows XP also, but requires an extra step to overcome the SendKeys issue.

Sub InsertField()
Dim oRng As Range
Dim i As Variant
Dim sSwitch As String
Dim strChoice As String
Dialogs(wdDialogInsertField).Show
On Error Goto Finish 'User has cancelled
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
Set oRng = Selection.Range
For i = 1 To oRng.Fields.Count
    With oRng.Fields(i)
        If InStr(1, .Code, "MERGEFORMAT") <> 0 Then
             sSwitch = MsgBox("Use charformat in place of the mergeformat switch?", _
             vbYesNo, _
             "Insert Field")
             If sSwitch = vbYes Then
                  .Code.Text = Replace(.Code.Text, _
                  "MERGEFORMAT", _
                  "CHARFORMAT")
             End If
             If sSwitch = vbNo Then
                  sSwitch = MsgBox("Remove switch?", _
                  vbYesNo, _
                  "Insert Field")
                  If sSwitch = vbYes Then
                       .Code.Text = Replace(.Code.Text, _
                       " \* MERGEFORMAT ", _
                       "")
                  End If
             End If
         End If
    .Update
    End With
Next i
Selection.MoveRight Unit:=wdCharacter, Count:=1
Finish:
End Sub



The Vista version of the macro has two message boxes. One of them is identical to the Windows XP version, the other is displayed when the user responds to the first box with 'No'



Number documents



There is a page on this site dedicated to numbering documents but on a number of occasions I have been asked for a variation of this to place an incrementing number at a bookmarked location in a series of documents. The example used here was created to print a batch of numbered receipts, and includes a second macro to reset the stored start number.

The macro uses a bookmark in the document template named RecNo



Sub AddNoFromINIFileToBookmark()
Dim SettingsFile As String
Dim Order As String
Dim iCount As String
Dim rRecNo As Range
Dim i As Long
iCount = InputBox("Print how many copies?", _
"Print Numbered Copies", 1)
If iCount = "" Then Exit Sub
SettingsFile = Options.DefaultFilePath(wdStartupPath) & "\Settings.ini"
Order = System.PrivateProfileString(SettingsFile, _
"DocNumber", "Order")
If Order = "" Then
    Order = 1
End If
For i = 1 To iCount
    Set rRecNo = ActiveDocument.Bookmarks("RecNo").Range
    rRecNo.Text = Format(Order, "00000")
    With ActiveDocument
        .Bookmarks.Add "RecNo", rRecNo
        .Fields.Update
        .ActiveWindow.View.ShowFieldCodes = False
        .PrintOut
    End With
    Order = Order + 1
Next i
System.PrivateProfileString(SettingsFile, "DocNumber", _
"Order") = Order
End Sub


Sub ResetStartNo()
Dim SettingsFile As String
Dim Order As String
Dim sQuery As String
SettingsFile = Options.DefaultFilePath(wdStartupPath) & "\Settings.ini"
Order = System.PrivateProfileString(SettingsFile, _
"DocNumber", "Order")
sQuery = InputBox("Reset start number?", "Reset", Order)
If sQuery = "" Then Exit Sub
Order = sQuery
System.PrivateProfileString(SettingsFile, "DocNumber", _
"Order") = Order
End Sub
 



Instead of printing a batch of similar numbered documents, the following variation simply adds the incremented number to each new document created from the template at the bookmarked location named RecNo. The reset macro above will reset this version equally as the following uses the same stored number data.



Sub AutoNew()
Dim SettingsFile As String
Dim Order As String
Dim rRecNo As Range
Dim i As Long

SettingsFile = Options.DefaultFilePath(wdStartupPath) & "\Settings.ini"
Order = System.PrivateProfileString(SettingsFile, _
        "DocNumber", "Order")
If Order = "" Then
    Order = 1
End If
    Set rRecNo = ActiveDocument.Bookmarks("RecNo").Range
    rRecNo.Text = Format(Order, "00000")
    With ActiveDocument
        .Bookmarks.Add "RecNo", rRecNo
        .Fields.Update
        .ActiveWindow.View.ShowFieldCodes = False
    End With
    Order = Order + 1
System.PrivateProfileString(SettingsFile, "DocNumber", _
        "Order") = Order
End Sub

Paste unformatted text



If you paste text from the internet for example, the paste will bring across all the formatting of the web page, whereas users frequently require the pasted text to adopt the formatting of the document into which it is pasted. This can be achieved with Paste Special > Unformatted text, but the macro recorder will not accurately record that action so....



Sub PasteUnfText()
    On Error GoTo oops
    Selection.PasteSpecial _
    DataType:=wdPasteText, _
    Placement:=wdInLine
    End
oops:
Beep
End Sub

Copy footnotes c/w formatting to a new document



Sub CopyFootnotes()
Dim sDoc As Document
Dim tDoc As Document
Dim sId As String
Set sDoc = ActiveDocument
Set tDoc = Documents.Add
For i = 1 To sDoc.Footnotes.Count
    sId = sDoc.Footnotes(i).Index
    sDoc.Footnotes(i).Range.Select
    Selection.Copy
    tDoc.Activate
    With Selection
        .Style = "Footnote Text"
        .Font.Superscript = True
        .TypeText sId & " "
        .Font.Superscript = False
        .Paste
        .TypeParagraph
    End With
    sDoc.Activate
Next i
tDoc.Activate
End Sub
Posted by at
Labels:

No comments:

Post a Comment

Subscribe to: Post Comments (Atom)