Formularfelder kopieren

Dieses kleine Projekt soll zeigen, wie sich die Eigenschaften von bestimmten Formularfeldern (Textfeld, Dropdown, CheckBox) auf andere Formularfelder übertragen lassen.

Ähnlich wie in Word der Pinsel zum Übertragen von Formatierungen, lassen sich mit der bereitgestellten Userform die Eigenschaften von Formularfeldern kopieren, wie z.B. die Ereignismakros, der Textfeldtyp (Datum,Zahl,Text mit jeweiligen Formaten).

Dazu werden für alle geöffneten Dokumente die Formularfelder aufgelistet. Nach Auswahl eines Formularfeldes werden die jeweiligen Eigenschaften ausgelesen und in einer Übersicht angezeigt. So lassen sich für das Quell- und Zieldokument das gewünschte Formularfeld auswählen und auf Wunsch die Eigenschaften auf das Ziel-Formularfeld übertragen.
Dabei werden bis auf den Namen alle Eigenschaften kopiert. Basiert das Zieldokument auf einer Vorlage, in der ein Ereignis-Makro des Quelldokumentes nicht existiert, wird das entsprechende Feld leer gelassen (bzw. von Word gelöscht).

Das Auslesen der Formularfeld-Eigenschaften erfolgt mit folgender Funktion, wobei neben dem Quell-Formularfeld das Quelldokumentes die Ausgabe-Listbox auf der Userform angegeben werden muss.

Sub FFProperties(oFF As FormField, ByRef oCTL As ListBox)  
On Error Resume Next
If Documents(Me.cbxZiel.Value).ProtectionType = wdAllowOnlyFormFields Then _
         Documents(Me.cbxZiel.Value).Unprotect
If Documents(Me.cbxQuelle.Value).ProtectionType = wdAllowOnlyFormFields Then _
         Documents(Me.cbxQuelle.Value).Unprotect
Select Case oFF.Type
Case wdFieldFormTextInput
  With oCTL
    .Clear
    .AddItem "Name"
    .List(.ListCount - 1, 0) = "Name"
    .List(.ListCount - 1, 1) = oFF.Name
    .AddItem "Value"
    .List(.ListCount - 1, 0) = "Value"
    .List(.ListCount - 1, 1) = oFF.Result
    .AddItem "Type"
    .List(.ListCount - 1, 0) = "Type"
    If oFF.TextInput.Type = wdCalculationText Then
      .List(.ListCount - 1, 1) = "wdCalculationText"
    ElseIf oFF.TextInput.Type = wdCurrentDateText Then
      .List(.ListCount - 1, 1) = "wdCurrentDateText"
    ElseIf oFF.TextInput.Type = wdCurrentTimeText Then
      .List(.ListCount - 1, 1) = "wdCurrentTimeText"
    ElseIf oFF.TextInput.Type = wdDateText Then
      .List(.ListCount - 1, 1) = "wdDateText"
    ElseIf oFF.TextInput.Type = wdNumberText Then
      .List(.ListCount - 1, 1) = "wdNumberText"
    ElseIf oFF.TextInput.Type = wdRegularText Then
      .List(.ListCount - 1, 1) = "wdRegularText"
    End If
    .AddItem "Defaultwert"
    .List(.ListCount - 1, 0) = "Defaultwert"
    .List(.ListCount - 1, 1) = oFF.TextInput.Default
    .AddItem "Format"
    .List(.ListCount - 1, 0) = "Format"
    .List(.ListCount - 1, 1) = oFF.TextInput.Format
    .AddItem "Textlänge"
    .List(.ListCount - 1, 0) = "Textlänge"
    .List(.ListCount - 1, 1) = oFF.TextInput.Width
    .AddItem "CalculateOnExit"
    .List(.ListCount - 1, 0) = "CalculateOnExit"
    .List(.ListCount - 1, 2) = oFF.CalculateOnExit
    .AddItem "EntryMacro"
    .List(.ListCount - 1, 0) = "EntryMacro"
    .List(.ListCount - 1, 1) = oFF.EntryMacro
    .AddItem "ExitMacro"
    .List(.ListCount - 1, 0) = "ExitMacro"
    .List(.ListCount - 1, 1) = oFF.ExitMacro
    .AddItem "Enabled"
    .List(.ListCount - 1, 0) = "Enabled"
    .List(.ListCount - 1, 1) = oFF.Enabled
    .AddItem "HelpText"
    .List(.ListCount - 1, 0) = "HelpText"
    .List(.ListCount - 1, 1) = oFF.HelpText
  End With
Case wdFieldFormCheckBox
  With oCTL
    .Clear
    .AddItem "Name"
    .List(.ListCount - 1, 0) = "Name"
    .List(.ListCount - 1, 1) = oFF.Name
    .AddItem "Wert"
    .List(.ListCount - 1, 0) = "Wert"
    .List(.ListCount - 1, 1) = oFF.CheckBox.Value
    .AddItem "AutoSize"
    .List(.ListCount - 1, 0) = "AutoSize"
    .List(.ListCount - 1, 1) = oFF.CheckBox.AutoSize
    .AddItem "Size"
    .List(.ListCount - 1, 0) = "Size"
    .List(.ListCount - 1, 2) = oFF.CheckBox.Size
    .AddItem "CalculateOnExit"
    .List(.ListCount - 1, 0) = "CalculateOnExit"
    .List(.ListCount - 1, 1) = oFF.CalculateOnExit
    .AddItem "EntryMacro"
    .List(.ListCount - 1, 0) = "EntryMacro"
    .List(.ListCount - 1, 1) = oFF.EntryMacro
    .AddItem "ExitMacro"
    .List(.ListCount - 1, 0) = "ExitMacro"
    .List(.ListCount - 1, 1) = oFF.ExitMacro
    .AddItem "Enabled"
    .List(.ListCount - 1, 0) = "Enabled"
    .List(.ListCount - 1, 1) = oFF.Enabled
    .AddItem "HelpText"
    .List(.ListCount - 1, 0) = "HelpText"
    .List(.ListCount - 1, 1) = oFF.HelpText
  End With
Case wdFieldFormDropDown
  Dim idx As Integer
  With oCTL
    .Clear
    .AddItem "Name"
    .List(.ListCount - 1, 0) = "Name"
    .List(.ListCount - 1, 1) = oFF.Name
    For idx = 1 To oFF.DropDown.ListEntries.Count
      .AddItem "Dropdownelement" & idx
      .List(.ListCount - 1, 0) = "Element " & idx
      .List(.ListCount - 1, 1) = oFF.DropDown.ListEntries(idx).Name
    Next idx
    .AddItem "CalculateOnExit"
    .List(.ListCount - 1, 0) = "CalculateOnExit"
    .List(.ListCount - 1, 1) = oFF.CalculateOnExit
    .AddItem "EntryMacro"
    .List(.ListCount - 1, 0) = "EntryMacro"
    .List(.ListCount - 1, 1) = oFF.EntryMacro
    .AddItem "ExitMacro"
    .List(.ListCount - 1, 0) = "ExitMacro"
    .List(.ListCount - 1, 1) = oFF.ExitMacro
    .AddItem "Enabled"
    .List(.ListCount - 1, 0) = "Enabled"
    .List(.ListCount - 1, 1) = oFF.Enabled
    .AddItem "HelpText"
    .List(.ListCount - 1, 0) = "HelpText"
    .List(.ListCount - 1, 1) = oFF.HelpText
  End With
End Select
Documents(Me.cbxQuelle.Value).Protect wdAllowOnlyFormFields, True
Documents(Me.cbxZiel.Value).Protect wdAllowOnlyFormFields, True
End Sub

Um auf die Eigenschaften überhaupt zugreifen zu können, muss zuerst der Formularschutz aufgehoben werden. Anschließend werden je nach Formularfeldtyp alle Eigenschaften ausgelesen und in der angegeben Listbox ausgegeben.

Wenn Quell- und Ziel-Formularfeld ausgewählt wurden (welche auch im selben Dokument enthalten sein können), können die Eigenschaften kopiert werden. Dies ist natürlich nur für verschieden Formularfelder gleichen Typs und nicht für das selbe Formularfeld möglich.
Nach dem Kopieren werden alle Eigenschaften des Ziel-Formularfeldes angezeigt; das Ziel-Dokument selbst wird jedoch nicht automatisch gespeichert.

Private Sub cmdCopy_Click()  
On Error Resume Next
lIDX = Me.cbxFFQ.ListIndex
rIDX = Me.cbxFFZ.ListIndex
lIDX1 = Me.cbxQuelle.ListIndex
rIDX1 = Me.cbxZiel.ListIndex
' Prüfen der Formularfeld-Typen  
Dim ff As FormField
Dim ff2 As FormField
Set ff = Documents(Me.cbxQuelle.Value).FormFields(Me.cbxFFQ.Value)
Set ff2 = Documents(Me.cbxZiel.Value).FormFields(Me.cbxFFZ.Value)
If ff.Type <> ff2.Type Or Me.cbxQuelle.Value = Me.cbxZiel.Value Then
  Me.cmdCopy.Enabled = False
  Exit Sub  
End If
' Sicherheitsabfrage  
Dim ret As Integer
ret = MsgBox("Sollen die ausgewählten Eigenschaften wirklich übertragen werden?", vbQuestion + vbYesNo, _
         Me.Caption)
If ret = vbNo Then Exit Sub  
' Formularschutz aufheben  
If Documents(Me.cbxQuelle.Value).ProtectionType = wdAllowOnlyFormFields Then _
         Documents(Me.cbxQuelle.Value).Unprotect
If Documents(Me.cbxZiel.Value).ProtectionType = wdAllowOnlyFormFields Then _
         Documents(Me.cbxZiel.Value).Unprotect
Select Case ff.Type
' Formulartyp auswerten und entsprechende Eigenschaften kopieren  
Case wdFieldFormTextInput
  With ff2
    If ff.TextInput.Type = wdCalculationText Then
      .TextInput.EditType wdCalculationText
    ElseIf ff.TextInput.Type = wdCurrentDateText Then
      .TextInput.EditType wdCurrentDateText, , CStr(ff.TextInput.Format)
    ElseIf ff.TextInput.Type = wdCurrentTimeText Then
      .TextInput.EditType wdCurrentTimeText, , CStr(ff.TextInput.Format)
    ElseIf ff.TextInput.Type = wdDateText Then
      .TextInput.EditType wdDateText, , CStr(ff.TextInput.Format)
    ElseIf ff.TextInput.Type = wdNumberText Then
      .TextInput.EditType wdNumberText, , CStr(ff.TextInput.Format)
    ElseIf ff.TextInput.Type = wdRegularText Then
      .TextInput.EditType wdRegularText, , CStr(ff.TextInput.Format)
    End If
    .TextInput.Default = ff.TextInput.Default
    .TextInput.Width = ff.TextInput.Width
    .CalculateOnExit = ff.CalculateOnExit
    .Enabled = ff.Enabled
    .EntryMacro = ff.EntryMacro
    .ExitMacro = ff.ExitMacro
    .Result = ff.Result
    .HelpText = ff.HelpText
  End With
Case wdFieldFormCheckBox
  With ff2
    .CheckBox.AutoSize = ff.CheckBox.AutoSize
    .CheckBox.Size = ff.CheckBox.Size
    .CheckBox.Default = ff.CheckBox.Default
    .CalculateOnExit = ff.CalculateOnExit
    .Enabled = ff.Enabled
    .EntryMacro = ff.EntryMacro
    .ExitMacro = ff.ExitMacro
    .CheckBox.Value = ff.CheckBox.Value
    .HelpText = ff.HelpText
  End With
Case wdFieldFormDropDown
  Dim idx As Integer
  With ff2
    .DropDown.ListEntries.Clear
    For idx = 1 To ff.DropDown.ListEntries.Count
      .DropDown.ListEntries.Add ff.DropDown.ListEntries(idx).Name
    Next idx
    .CalculateOnExit = ff.CalculateOnExit
    .Enabled = ff.Enabled
    .EntryMacro = ff.EntryMacro
    .ExitMacro = ff.ExitMacro
    .HelpText = ff.HelpText
  End With
End Select
' Formularschutz wieder setzen  
Documents(Me.cbxQuelle.Value).Protect wdAllowOnlyFormFields, True
Documents(Me.cbxZiel.Value).Protect wdAllowOnlyFormFields, True
Documents(Me.cbxZiel.Value).Fields.Update
' Alle Formularfelder neu einlesen  
UserForm_Initialize
'  
Me.cbxQuelle.ListIndex = lIDX1
Me.cbxZiel.ListIndex = rIDX1
Me.cbxFFQ.ListIndex = lIDX
Me.cbxFFZ.ListIndex = rIDX
End Sub