Tipp 0406 Formularfelder über UserForm ausfüllen
Autor/Einsender:
Datum:
  Angie
05.08.2004
Entwicklungsumgebung:   Word 2000
Bei einem Formular handelt es sich um ein strukturiertes Dokument mit freien Bereichen, in die Informationen an bestimmten Stellen eingegeben werden können. In diesem Beispiel handelt es sich um ein Formular, das Benutzer in Word betrachten und ausfüllen können, verwendet wurden hier die Formularfelder Textfeld, Dropdown-Liste und Kontrollkästchen von der Symbolleiste 'Formular'. Weitere Infos zum Thema Formulare in Word können der Word-Hilfe entnommen werden, wo das Thema sehr ausführlich beschrieben ist.
Prinzipiell soll dieses Beispiel einen kleinen Einblick in den VBA-technischen Umgang mit Formularfeldern geben. Es kann in manchen Fällen durchaus sinnvoll sein, bei den Formularfeldern die Option "Eingabe zulassen" zu deaktivieren (eine Eingabe im Formularfeld im Dokument ist damit nicht mehr möglich), und das Ausfüllen der Formularfelder über eine UserForm zu steuern. Es ist zwar möglich, mit Hilfe der Eintritt- und Verlassen-Makros ein Formular zu automatisieren, dies kann aber unter Umständen zu einem erheblich größeren Programmieraufwand führen.
Anmerkungen zum Code
Textmarkennamen der Formularfelder
Die Textmarkennamen der Formularfelder sind identisch mit den Namen der entsprechenden Steuerelemente auf der UserForm.
Formularfelder mit Textmarkennamen ansprechen
In diesem Beispiel wird der Name des anzusprechenden Formularfeldes in einer Variable gespeichert. Auf Grund eines Bugs in Word 97 muss die Variable 'As Variant' definiert werden. Ab Word 2000 kann die Variable 'As String' definiert werden.
Listeneinträge in ComboBox / DropDown-Formularfeld
Die Listeneinträge für die ComboBox auf der UserForm werden beim Laden der UserForm aus der Liste im DropDown-Formularfeld im Dokument ausgelesen.
Einem Text-Formularfeld mehrzeiligen Text mit Absatz-/Zeilenschaltung zuweisen
Unter bestimmten Umständen wird statt der Absatz-/Zeilenschaltung im Textformularfeld ein kleines eckiges Kästchen angezeigt. Um dies zu vermeiden, wird in diesem Beispiel zunächst überprüft, ob in der MultiLine-TextBox Absatzschaltungen vorhanden sind. Ist dies der Fall, wird die Kombination aus Wagenrücklauf und Zeilenvorschub vbCrLf bzw. Chr(13) + Chr(10) ersetzt, für eine Absatzschaltung mit dem Wagenrücklaufzeichen vbCr bzw. Chr(13), für eine Zeilenschaltung mit der Konstante vbVerticalTab bzw. Chr(11), dessen Verwendung laut VB(A)-Hilfe "Nicht sinnvoll unter Microsoft Windows" ist.
Hier wurde die Option, ob Absatz- oder Zeilenschaltungen im Text-Formularfeld verwendet werden sollen, in einer Dokument-Variable gespeichert.
Replace-Funktion
Die Ersatzfunktion für Office 97 für die in diesem Beispiel verwendete Replace-Funktion ist im Download-Beispiel enthalten.
Einem Text-Formularfeld Text mit mehr als 256 Zeichen zuweisen
Sollen einem Text-Formularfeld mehr als 256 Zeichen zugewiesen werden, führt folgende Anweisung zu der Fehlermeldung "Zeichenfolge zu lang.":
 
  Dim strText As String

  strText = "Test-String " & String(300, "A") & " Test-String"
  ActiveDocument.FormFields("Text1").Result = strText
 
Abhilfe schaffen die folgenden beiden Code-Beispiele:
 
Sub Beispiel_1()
  Dim strText   As String
  Dim objFField As FormField

  strText = "Test-String " & String(300, "A") & " Test-String"
  Set objFField = ActiveDocument.FormFields("Text1")

  ActiveDocument.Unprotect
  objFField.Range.Fields(1).Result.Text = strText
  ActiveDocument.Protect Type:=wdAllowOnlyFormFields, _
                         NoReset:=True
  Set objFField = Nothing
End Sub

Sub Beispiel_2()
  Dim strText As String

  strText = "Test-String " & String(300, "A") & " Test-String"

  With ActiveDocument
    .Unprotect
    .Bookmarks("Text1").Range.Fields(1).Result.Text = strText
    .Protect Type:=wdAllowOnlyFormFields, NoReset:=True
  End With
End Sub
 
Code im Codebereich der UserForm
 
Option Explicit

Private Const mc_DocVarLineFeed As String = "LineFeed"

Private m_objDoc  As Word.Document

Private Sub UserForm_Initialize()
  With Me.txtTextfeld2
    .MultiLine = True
    .EnterKeyBehavior = True
  End With

  Me.cboDropDown.Style = fmStyleDropDownList
  Me.cmdOK.Default = True
  Me.cmdCancel.Cancel = True
End Sub

Private Sub UserForm_Activate()
  Dim strDocVar As String

  Dim objCtl    As Control
  Dim objFField As FormField
  Dim strName   As Variant

  Dim i         As Integer

  On Error Resume Next
  Set m_objDoc = ActiveDocument

  If m_objDoc.ProtectionType = wdNoProtection Then
    m_objDoc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
  End If

  strDocVar = GetDocVarValue(m_objDoc, mc_DocVarLineFeed)
  If InStr(1, strDocVar, "Absatz", vbTextCompare) Then
    Me.optChr13.Value = True
  Else
    Me.optChr11.Value = True
  End If

  For Each objCtl In Me.Controls
    If TypeOf objCtl Is MSForms.TextBox Or _
          TypeOf objCtl Is MSForms.CheckBox Or _
          TypeOf objCtl Is MSForms.ComboBox Then

      strName = objCtl.Name

      If m_objDoc.Bookmarks.Exists(strName) Then
        Err.Clear
        Set objFField = m_objDoc.FormFields(strName)

        If Err.Number = 0 Then
          Select Case objFField.Type
            Case wdFieldFormTextInput
              objCtl.Text = objFField.Result

            Case wdFieldFormCheckBox
              objCtl.Value = objFField.CheckBox.Value

            Case wdFieldFormDropDown
              Me.Controls(strName).Clear
              With objFField.DropDown
                For i = 1 To .ListEntries.Count
                  Me.Controls(strName).AddItem _
                        .ListEntries(i).Name
                Next
                Me.Controls(strName).ListIndex = .Value - 1
              End With

            Case Else
          End Select
          Set objFField = Nothing
        End If
      End If
    End If
  Next
  On Error GoTo 0
End Sub

Private Sub cmdOK_Click()
  Dim objCtl    As Control
  Dim objFField As FormField
  Dim strName   As Variant

  Dim strChr    As String
  Dim strText   As String

  If (m_objDoc Is Nothing) Then Exit Sub

  If m_objDoc.ProtectionType = wdNoProtection Then
    m_objDoc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
  End If

  On Error Resume Next
  If Me.optChr13.Value = True Then
    strChr = Chr$(13)
    m_objDoc.Variables(mc_DocVarLineFeed).Value = _
             "Absatzschaltungen"

  Else
    strChr = Chr$(11)
    m_objDoc.Variables(mc_DocVarLineFeed).Value = _
             "Zeilenschaltungen"
  End If

  For Each objCtl In Me.Controls
    If TypeOf objCtl Is MSForms.TextBox Or _
          TypeOf objCtl Is MSForms.CheckBox Or _
          TypeOf objCtl Is MSForms.ComboBox Then

      strName = objCtl.Name

      If m_objDoc.Bookmarks.Exists(strName) Then
        Err.Clear
        Set objFField = m_objDoc.FormFields(strName)

        If Err.Number = 0 Then
          Select Case objFField.Type
            Case wdFieldFormTextInput
              strText = objCtl.Text

                If InStr(1, strText, Chr$(13) + Chr$(10)) Then
                  #If VBA6 Then
                    strText = VBA.Replace(strText, _
                                  Chr$(13) + Chr$(10), strChr, 1)
                  #Else
                    strText = Replace(strText, _
                                  Chr$(13) + Chr$(10), strChr, 1)
                  #End If
                End If

                If Len(strText) > 256 Then
                  m_objDoc.Unprotect
                  objFField.Range.Fields(1).Result.Text = strText
                  m_objDoc.Protect Type:=wdAllowOnlyFormFields, _
                                   NoReset:=True

                Else
                  objFField.Result = strText
                End If

            Case wdFieldFormCheckBox
              objFField.CheckBox.Value = objCtl.Value

            Case wdFieldFormDropDown
              objFField.DropDown.Value = objCtl.ListIndex + 1

            Case Else
          End Select
          Set objFField = Nothing
        End If
      End If
    End If
  Next
  On Error GoTo 0

  Unload Me
End Sub

Private Sub cmdCancel_Click()
  Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, _
        CloseMode As Integer)
  If (Not m_objDoc Is Nothing) Then
    Set m_objDoc = Nothing
  End If
End Sub

Private Function GetDocVarValue(ByVal objDoc As Document, _
      ByVal vsDocVar As String) As String

  Dim objDocVar As Variable
  Dim nIndex    As Long

  For Each objDocVar In objDoc.Variables
    If objDocVar.Name = vsDocVar Then
      nIndex = objDocVar.Index
      Exit For
    End If
  Next

  If nIndex = 0 Then
    objDoc.Variables.Add Name:=vsDocVar, _
              Value:="Absatzschaltungen"
    GetDocVarValue = "Absatzschaltungen"
  Else
    GetDocVarValue = objDoc.Variables(nIndex).Value
  End If
End Function
 

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Word-Version
95
97
2000
2002 (XP)
2003
2007
2010


Download  (34,6 kB) Downloads bisher: [ 2316 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 22. Mai 2011