Propagate Problem - Tablet PC


Many people access the material from this web site daily. Most just leech what they want and run. That's OK, provided they are not selling on the material as their own; however if your productivity gains from the material you have used, a donation from the money you have saved, however small, would help to ensure the continued availability of this resource. Click the appropriate button above to access PayPal.

Tablet PC - Correct inability to fully propagate labels

	For some time Microsoft users have been aware of a problem relating to the failure to fully propagate labels in Word's mail merge function, when used with a Tablet PC. e.g. If you insert an Address block in the first label position, and then tap Update all labels at step 4 of 6 in the Mail Merge wizard, only the first row and the last two labels on the last row will be updated with the AddressBlock field. The other labels will only have the Next Record field inserted. This is addressed by Microsoft at http://support.microsoft.com/kb/898630/en-us . However it now appears that with the introduction of Office 2007, the problem may be more widespread, as a user in the Word mail merge forum found that he experienced the same issue with a Dell Dimension DXP061 2.4GHZ Intel dual core, 4 GB RAM, running Vista Home Premium, & Office 2007. To address this, until Microsoft creates a fix, fellow MVP Doug Robbins has come up with another of is macro solutions, which is posted below. This intercepts and replaces the in-built propagation tool.
The Macro Code
	Sub MailMergePropagateLabel() Dim atable As Table Dim i As Long Dim j As Long Dim source As Cell Dim target As Cell Dim myrange As Range Set atable = ActiveDocument.Tables(1) Set source = atable.Cell(1, 1) Set myrange = source.Range myrange.Collapse wdCollapseStart ActiveDocument.Fields.Add Range:=myrange, Text:="NEXT", _ PreserveFormatting:=False source.Range.Copy For j = 2 To atable.Columns.Count Set target = atable.Cell(1, j) If target.Range.Fields.Count > 0 Then target.Range.Paste End If Next j For i = 2 To atable.Rows.Count For j = 1 To atable.Columns.Count Set target = atable.Cell(i, j) If target.Range.Fields.Count > 0 Then target.Range.Paste End If Next j Next i atable.Cell(1, 1).Range.Fields(1).Delete End Sub
Note:	If you do not know how to employ this code, see the tutorial elsewhere on this site.