Office VBA Macros You Can Use Today phần 6 doc

Wrd Private Sub WdApp_MailMergeAfterMergeByVal Doc As Document, _¶ ByVal DocResult As Document¶ 'Release the data¶ MsgBox "Merge process has finished!"¶ 'Display the merge result doc

'Restore the bookmark around the table¶

rng.Parent.Bookmarks.Add Range:=tbl.Range, Name:=BookmarkName¶

Public WithEvents WdApp As Word.Application¶

Const sMergeMessage As String = "The merge process can take some time."

& _¶

vbCr & vbCr & "Word may pause and seem to hang while the charts

update." _¶

& vbCr & vbCr & "Please do NOT try to work " & _¶

"in Word until the 'finish' message has been displayed!"¶

Private rs As ADODB.Recordset¶

Wrd

Private Sub WdApp_MailMergeAfterMerge(ByVal Doc As Document, _¶

ByVal DocResult As Document)¶

'Release the data¶

MsgBox "Merge process has finished!"¶

'Display the merge result document¶

If Not DocResult Is Nothing Then¶

Private Sub WdApp_MailMergeBeforeRecordMerge( _¶

ByVal Doc As Document, Cancel As Boolean)¶

'Variable declaration¶

Dim bkm As Word.Bookmark¶

'If something is wrong, don't continue¶

'processing each record¶

If CancelMerge = True Then¶

Debug.Print "Cancelled Record: " & CStr(recordIndex)¶

Cancel = True¶

Exit Sub¶

End If¶

'The file containing the data for the merge¶

'should only be opened once Therefore,¶

'track when the merge has started¶

If BeforeMergeExecuted = False Then¶

BeforeMergeExecuted = True¶

MsgBox sMergeMessage, vbCritical + vbOKOnly¶

Set rs = New ADODB.Recordset¶

rs.CursorLocation = adUseClient¶

'Retrieve the entire recordset¶

'then get the individual records for each pupil¶

Wrd

End If¶

'If there is no target, then¶

'don't try to insert the table¶

Follow these steps:

1 Locate the 'Setup' procedure in the standard module Change the

information pertinent to the operating system and mail merge that

needs to be specified as follows:

¾ BookmarkName Name of the bookmark where the list should be

inserted

¾ DatabasePath Full path to the database holding the list

(This does not have to be the same database or application containing the data for the mail merge.)

¾ TableName Name of the table or query with the list data

¾ FieldNames(): Array of the field names with the list data

a Type each field name in between a pair of

¾ sepChar: Delimiting character

(The list of data is read from the table into a delimited string of text.)

a Delimited means that each field's and each record's value are separated from the others

by a particular character Word can convert a delimited text string into a table

b The record separator must always be a paragraph mark; the field separator can be any character Choose one that is not present

in the data

2 Prepare the mail merge main document normally Place a bookmark where the list should be inserted In the sample macro it is named GradeTable, but you can use any name you wish Just be sure to change

it in the macro, as described further down

3 Go into Tools | References in the VBE and activate the checkbox next to one of the Microsoft ActiveX Data Object libraries (ADO) Any version will do; the sample file references version 2.0

4 ADO connections are application-specific If an Excel table is used instead of an Access database, a different connection ('conn' in the procedure 'GetData') is needed

Find the code for an Excel connection on page 371 in the Filling a Word Combo Box with Data from Excel procedure in the Combined

Procedures Section For other database types, see the information on ADO OLE DB connections at http://www.able-consulting.com/tech.htm If the data is in a Word table, see the code for generating an MS Graph chart in the ‘Mail Merge: Merging with a Chart’ process, which follows

Wrd

Mail Merge: Merging with a Chart

This procedure allows you to create a chart for each mail merge record, based

on a sample chart in the main mail merge document, and demonstrates

automating MS Graph using mail merge events

Example file:

MailMergeData, MailMergePieChartLetter, MailMergePieChartData, MailMergeColChartLetter, and MailMergeColChartData There are four basic ways to accomplish this; all of these methods require a

macro if there are a substantial number of records to be merged

1 Create a chart for each record in Excel Add a column to the data table

and enter the name of the appropriate chart for each record Use this

merge field in LINK field in the mail merge document

2 Use a database field in the main merge document to create a data table

for each merge record

See http://www.knowhow.com/Guides/DatabaseInfo/DatabaseInfo.htm

for details

Select the table and link it to an MS Graph Preview the merge data,

one record at a time, and print each individually Executing the merge

would remove the bookmark that links the table to the chart, resulting

in the same chart for all records

3 Create the chart for each record chart in the mail merge result

document, after the mail merge has executed

4 Create the charts on-the-fly, as the mail merge executes

This macro applies the fourth method Since it relies on the mail merge events

introduced in Word 2002, it only works with that version or later versions The

other three methods work with all versions of Word

View the Appendix to learn how to store this procedure

in a Standard module

Scenario: Just as Word's mail merge doesn't

support merging one-to-many item lists, it also

provides no way to create a chart for each record

Wrd

Option explicit¶

' * * * * *¶

Public x As New clsMergeEvents¶

Public BeforeMergeExecuted As Boolean¶

Public CancelMerge As Boolean¶

Public recordIndex As Long¶

Const ChartDataDoc As String = "MailMergePieChartData.doc"¶

'The events in the class module¶

'clsMergeEvents will be enabled¶

'Turn the events off so that they¶

'only execute for this document¶

Dim FilePath As String¶

'Combine the path where the main merge doc¶

'is stored plus the specified name of the¶

'document containing the data for the chart¶

FilePath = LocalPath & "\" & ChartDataDoc¶

'Make sure the data file exists¶

'before trying to open it¶

Dim oChart As Graph.Chart¶

Dim oDataSheet As Graph.DataSheet¶

Dim tbl As Word.Table¶

Dim chartType As Long¶

Set tbl = DataDoc.Tables(1)¶

'Activate the MS Graph object in the¶

'main merge document¶

Set of = rng.InlineShapes(1).OLEFormat¶

of.DoVerb wdOLEVerbInPlaceActivate¶

'Pick up the chart for automation¶

Set oChart = of.Object¶

'Is chart a pie chart or not?¶

chartType = oChart.chartType¶

'Data sheet required¶

Set oDataSheet = oChart.Application.DataSheet¶

oChart.DisplayBlanksAs = xlNotPlotted¶

FillDataSheet oDataSheet, tbl, chartType¶

'Finish with the chart¶

Sub FillDataSheet(ByRef ds As Graph.DataSheet, _¶

tbl As Word.Table, chartType As Long)¶

Wrd

' * * * * *¶

Sub ProcessPieChart(ByRef ds As Graph.DataSheet, _¶

tbl As Word.Table, ByVal nrDataCols As Long)¶

'Variable declaration¶

Dim rwData As Word.Row¶

Dim datavalue As Double¶

Dim rwLabels As Word.Row¶

Dim colcounter As Long, i As Long¶

colcounter = 1¶

'Data series in rows!¶

ds.Application.PlotBy = xlRows¶

'First column contains record ID¶

'Following columns contain data¶

'One row per record¶

'First row contains Legend labels¶

Set rwLabels = tbl.Rows(1)¶

Set rwData = tbl.Rows(recordIndex)¶

'Loop through the data columns¶

For i = 2 To nrDataCols¶

With ds¶

datavalue = CDbl(Val( _¶

TrimCellText(rwData.Cells(i).Range.Text)))¶

'Don't carry over 0 values¶

'If 0 values should be used¶

'comment out If and End If lines¶

Sub ProcessOtherChart(ByRef ds As Graph.DataSheet, _¶

tbl As Word.Table, ByVal nrDataCols As Long)¶

'Variable declaration¶

Dim rwData As Word.Row¶

Dim rwLabels As Word.Row¶

Dim rowCounter As Long¶

Dim totalRows As Long¶

Dim ID As String¶

Dim datavalue As Double¶

Dim colcounter As Long, i As Long¶

colcounter = 1¶

rowCounter = 1¶

totalRows = tbl.Rows.Count¶

Wrd

'Data series in columns!¶

ds.Application.PlotBy = xlColumns¶

'First column contains record ID¶

'Second column contains legend labels¶

'Following columns contain data¶

'First row contains x-axis labels¶

Set rwLabels = tbl.Rows(1)¶

Set rwData = tbl.Rows(recordIndex)¶

'There can be multiple rows / merge record¶

'therefore loop through table rows until¶

'ID (value in col 1) changes¶

'Stop if the end has been reached¶

If totalRows < recordIndex Then Exit Do¶

'Otherwise, move to the next row¶

'Then perform the ID check before looping back¶

Set rwData = tbl.Rows(recordIndex)¶

Loop While ID = TrimCellText(rwData.Cells(1).Range.Text)¶

'Reset in order to start with correct row for next record¶

recordIndex = recordIndex - 1¶

End Sub¶

' * * * * *¶

Function TrimCellText(s As String) As String¶

'Remove end-of-cell markers¶

TrimCellText = Left(s, Len(s) - 2)¶

End Function¶

View the Appendix to learn how to store this procedure

in a Class module

Wrd

Option explicit¶

' * * * * *¶

Public WithEvents WdApp As Word.Application¶

Private DataDoc As Word.Document¶

Const BookmarkName As String = "PieChart"¶

Const sMergeMessage As String = "The merge process can take some time."

& _¶

vbCr & vbCr & "Word may pause and seem to hang while the charts update." _¶

& vbCr & vbCr & "Please do NOT try to work " & _¶

"in Word until the 'finish' message has been displayed!"¶

Private Sub WdApp_MailMergeAfterMerge(ByVal Doc As Document, _¶

ByVal DocResult As Document)¶

DataDoc.Close SaveChanges:=wdDoNotSaveChanges¶

Set DataDoc = Nothing¶

MsgBox "Merge process has finished!"¶

'Display the merge result document¶

If Not DocResult Is Nothing Then¶

DocResult.Activate¶

End If¶

End Sub¶

' * * * * *¶

Private Sub WdApp_MailMergeBeforeRecordMerge( _¶

ByVal Doc As Document, Cancel As Boolean)¶

'Variable declaration¶

Dim rngChart As Word.Range¶

' Dim rngControl As Word.Range¶

' Dim EmployeeName As String¶

Debug.Print Doc.Characters.Count, Asc(Doc.Characters.Last)¶

'If something is wrong, don't continue¶

'processing each record¶

If CancelMerge = True Then¶

Debug.Print "Cancelled Record: " & CStr(recordIndex)¶

Cancel = True¶

Exit Sub¶

End If¶

'The file containing the data for the merge¶

'should only be opened once Therefore,¶

'track when the merge has started¶

If BeforeMergeExecuted = False Then¶

BeforeMergeExecuted = True¶

MsgBox sMergeMessage, vbCritical + vbOKOnly¶

Set DataDoc = OpenChartDataFile(Doc.Path)¶

End If¶

If DataDoc Is Nothing Then¶

MsgBox "The data document could not be opened."¶

Wrd

'don't try to insert it¶

If Doc.Bookmarks.Exists(BookmarkName) Then¶

Set rngChart = Doc.Bookmarks(BookmarkName).Range¶

EditChart rngChart, DataDoc¶

'Make sure the changes to the chart¶

'are carried over to the merge result¶

rngChart.Fields.Update¶

End Sub¶

Prepare the chart data: The data should be in a Word table, in a Word

document, saved in the same folder as the main merge document

If the data is in a table in another application, such as Access or Excel, simply

copy and paste it into a Word document Take care that the records are sorted

in the same order as for the mail merge, and that there is at least one row of

data for each record

The following data table was copied from an Access query and pasted into a

Word document Then the first row (containing the query name) was deleted

Figure 60 – Mail Merge with Charts

Wrd

The first column contains the ID information relating to the merge record The second and following columns provide the data for a pie chart, such as shown in Figure 61

Figure 61 – Letter with Chart Merged

The code can also produce other kinds of charts as well The example below shows the source data for a column chart In this case, the second column corresponds to the x-axis labels of the column chart, and the remaining

columns contain the data

Wrd

Figure 62 – Letter with Column Chart Merged

Figure 63 shows the resulting letter with a column chart embedded

Wrd

Figure 63 – Chart with Legend

In both cases, the first row contains the legend text for the chart

Tip: Because it simply fills the datasheet of an MS Graph object that is inserted and formatted,

the macro solution can be used with any kind of chart

Follow these steps:

1 Save the data document and substitute its name for the code line Const ChartDataDoc

2 Set up the main merge document as a form letter in the normal fashion Use Insert | Object to insert a Microsoft Graph Chart Choose the type

of chart you want and format it as desired The macro changes only the data in the data sheet Select the chart, then over Insert | Bookmark, insert a bookmark named PieChart

Wrd

Tips: The chart and bookmark can be in a table cell or a frame in order to have text flow

around the chart

If a different bookmark name is used, just remember to change the information for the

code line Const BookmarkName

3 Go into Tools | References in the Visual Basic Editor (VBE) and

activate the checkbox next to Microsoft Office Graph 10.0 Object

Library (Office 2002) or Microsoft Office Graph 11.0 Object Library

(Office 2003)

4 There are sample files for both pie and column chart merges Both use

MailMergeData.doc for the data source; link the sample mail merge

letter files to them before running the 'MergeToChart' code

Note: Pay attention to the message that is displayed at the start! The updating of

the MS Graph charts in the document can take a number of seconds, and

Word may appear to hang It hasn’t Be patient and wait until the finishing

message has been displayed

Transferring a Selection to a New Document

This procedure demonstrates how to access page setup properties, headers,

footers, and page numbers

Example file:

W031

Scenario: One request for help seen quite often, especially

for persons moving to Word from WordPerfect, is how to

save a selection to a new file While copying the selection

and pasting it into a new document is one solution, there are

two major issues involved: additional steps that are required,

and lost formatting due to differences in margins, styles,

headers, and footers in the new document as opposed to the

original document

With this macro, a selection can be quickly transferred into a

new document, retaining all the original formatting

Wrd

Figure 64 – Transferring a Selection to a New Document

View the Appendix to learn how to store this procedure

Dim rngSel As Word.Range¶

Dim origSetup As Word.PageSetup¶

Dim docNew As Word.Document¶

Wrd

'Assign the selection to its variable¶

Set rngSel = Selection.Range¶

Set origSetup = rngSel.Sections(1).PageSetup¶

'Create a new document from the current document¶

'So that styles, etc are all present¶

Set docNew = Documents.Add(ActiveDocument.FullName)¶

'Delete everything¶

docNew.Range.Delete¶

'Put the selection into the new document¶

docNew.Range.FormattedText = rngSel.FormattedText¶

'Set the page properties to correspond¶

'to the settings for the section in which¶

'the selection was made¶

' in result document if present in original even if¶

' selection is not originally on a first page¶

'To NOT retain the original page number,¶

'comment out the next four lines¶

'Carry over formatted text for the selected section¶

'from original document and update the fields¶

Sub ProcessHeadersFooters(typ As Long, _¶

sec1 As Word.Section, sec2 As Word.Section)¶

Wrd

It was difficult to decide exactly what to include in this tool because there are

varying requirements as to what kinds of setup formatting should be retained

or discarded Comment out any of the property assignments under With

docNew.Sections(1).PageSetup that should not transfer to the new document

If the original document has page numbers, consider whether it is better to

retain the original page number or to let the new document begin counting at 1

To do the latter, comment out these four lines in the procedure:

With docNew.Sections(1).Headers _ (wdHeaderFooterPrimary)¶

.PageNumbers.RestartNumberingAtSection = True¶

.PageNumbers.StartingNumber = pgNr¶

End With¶

If DifferentFirstPage is activated for headers and footers, decide whether the

new document should reflect this or if it should begin with the header and

footer used on the page on which the selection begins To not suppress

DifferentFirstPage when the original selection does not begin on a first page,

comment out these lines, EXCEPT for the second and third lines

Wrd

Splitting a Document into Multiple Files

This procedure shows you chow to split a document into separate files

according to heading styles applied to the text It also shows you how to work with Subdocuments

Example file:

W032

Tip: Key points for staying out of trouble when using Master documents:

1 Make back-up copies of the sub-documents frequently

2 Never, ever edit subdocuments when they are open in a Master document Consider the Master document as a throw-away container for pulling individual documents together for printing or viewing purposes

This macro tool splits a document into sub-documents based on heading styles You can specify the heading levels to which the document should be split

Scenario: Sometimes, it is necessary to split up a document

into separate files; for instance, to allow a number of persons

to edit different chapters at the same time Another case

would be to create a website from the document

The easiest way in Word to pull a document apart or to bring

separate documents together is with the Master/Subdocument

feature, available in the Outline view Over the last decade,

this feature has caused lots of problems primarily because

people have tried to use it in ways the developers never

intended For the basic task of splitting or combining

documents, however, it's quite reliable

Wrd

Figure 65 – Defining the Heading Level for Splitting a Document

Tip: The tool is language independent; for example, it doesn't matter whether the style in the

active document is named "Heading 1" or "Überschrift 1"

View the Appendix to learn how to store this procedure

Dim doc As Word.Document¶

Set doc = ActiveDocument¶

'Recommended to save to a new name¶

'as original document will not¶

'be recoverable¶

Dialogs(wdDialogFileSaveAs).Show¶

SplitByLevel doc¶

Wrd

'Saving automatically saves subdocs¶

'to names using text of first paragraph¶

doc.Save¶

'''Save merge result to¶

'''separate files¶

' Convert all sections to Subdocs¶

' (for mail merge result, for example)¶

"From which heading level do you want to " & _¶

"split the document into separate documents?")¶

'Invalid entry: outline levels from 1 to 9¶

'Must be in MasterView to work with¶

'Subdocs as separate files¶

Set rngSearch = doc.Range¶

styleName = GetStyleName(doc, i)¶