Option Explicit
Option Base 1
Const MergeFolder = "C:\Amerge\"
Const FileType = ".rtf"
Private Sub UserForm_Initialize()
Dim i As Integer, DataFiles, DF
DataFiles = Array("MergeData1", "MergeData2", "MergeData3")
For Each DF In DataFiles
i = i + 1
Controls.Item("OptionButton" & i).Caption = DF
Controls.Item("OptionButton" & i).Visible = True
Next
End Sub
Private Sub SetSource(MySource)
ActiveDocument.MailMerge.OpenDataSource Name:=MergeFolder & MySource & FileType, _
ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:="", SQLStatement:="", SQLStatement1 _
:=""
GetText
End Sub
Sub GetText()
Dim afield
For Each afield In ActiveDocument.MailMerge.DataSource.DataFields
ListBox1.AddItem afield.Name
Next afield
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:=ListBox1
End Sub
Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = 13 Then
ActiveDocument.Fields.Add Range:=Selection.Range, Type:=wdFieldMergeField _
, Text:=ListBox1
End If
End Sub
Private Sub ListBox1_Click()
Label1.Caption = " " & ActiveDocument.MailMerge.DataSource.DataFields(ListBox1).Value
End Sub
Private Sub OptionButton1_Click()
ListBox1.Clear
Label1.Caption = ""
SetSource OptionButton1.Caption
End Sub
Private Sub OptionButton2_Click()
ListBox1.Clear
Label1.Caption = ""
SetSource OptionButton2.Caption
End Sub
Private Sub OptionButton3_Click()
ListBox1.Clear
Label1.Caption = ""
SetSource OptionButton3.Caption
End Sub
Private Sub OptionButton4_Click()
ListBox1.Clear
Label1.Caption = ""
SetSource OptionButton4.Caption
End Sub
Private Sub OptionButton5_Click()
ListBox1.Clear
Label1.Caption = ""
SetSource OptionButton5.Caption
End Sub
Private Sub Image1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ActiveDocument.FollowHyperlink _
Address:="http://www.vbaexpress.com/", _
NewWindow:=True
End Sub
|