2
www.ChF-Online.de  

Formularfelder kopieren
   Neuigkeiten
   API-Aufrufe in VBA
   VBA2HTML
   Word
   Word-VBA
 Verschiedenes
aktiv aktiv Feld-Arbeiten
 Felder aktualisieren
 Felder aktualisieren (II)
 Felder aktualisieren (III)
 Feldfunktion darstellen
 Formularfelder (I)
 Formluarfelder formatieren
aktiv  Formularfelder kopieren
 IHV formatieren
 Aktuelle Kalenderwoche
 Formular-QuickInfos
 Verkn. Dateien drucken
 Form-Sachen
 Menü-/Symbolleisten
 VBA und Lotus Notes
 VBA und Mail
 Inside VBAIDE
 Von Word nach Outlook
 Fix-und-Fertiges/Projekte
   Word2007 (RibbonX)
   Word2010 (RibbonX)
   Outlook-VBA
   Links zu VB(A)
   DocToHelp
   Netport Express XL
   Astronomie
   Gästebuch
   Volltextsuche
   Sitemap
   Buch:Word-Programmierung
   Impressum & Kontakt
   Datenschutzerklärung
Microsoft Word-Programmierung - Das Handbuch 4. Auflage für Word 2007 bis 2013!
ersch. 02/2014
Getestet unter Word2000Getestet unter WordXPGetestet unter Word2003  
Beispiel anzeigen
Makro/Datei speichern
Print

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).

Übertragen von Formularfeld-Eigenschaften

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.

Code markieren 
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.

Code markieren 
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

Wichtig:
Um die zum Download bereitgestellte Userform in eigenen Vorlagen verwenden zu können, muüssen beide Dateien in einen beliebigen Ordner entpackt und die frm-Datei im VBA-Editor importiert werden. Die frx-Datei wird dabei automatisch mitimportiert.
 Besucher: 2 online  |  16 heute  |  2178 diesen Monat  |  2154438 insgesamt | Seitenaufrufe: 60   Letzte Änderung: 05.10.2009 © 2001-18 Christian Freßdorf
  Logiker, die philosophieren, sind scharfsinnige Irre.
R. Vollmann
  powered by phpCMS and PAX