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. 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. 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: |
Besucher: 0 online | 0 heute | 0 diesen Monat | 2215540 insgesamt | Seitenaufrufe: 54 | Letzte Änderung: 05.10.2009 | © 2001-18 Christian Freßdorf | ||||
Die letzte Stimme, die man hören wird, bevor die Welt explodiert, wird die eines Experten sein, der sagt: "Das ist technisch unmöglich!" Sir Peter Ustinov |
powered by phpCMS and PAX |