Word VBA - tekstvakken

word_vba_tekstvakkenSoms is het wenselijk om vooraf per tekstvak te bepalen hoeveel regels er maximaal mogen worden ingevuld. Door deze validatie voorkomt u dat de tekstvakken en afbeeldingen in uw Word-document verspringen. Deze functionaliteit kan handig zijn bij het ontwerpen van bijvoorbeeld een nieuwsbrief.

Met behulp van het onderstaande project kunt u dit bewerkstelligen.

ThisDocument

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Subroutine
' Opmerking     : knop in document
'-----------------------------------------------------------------------------------------------------------------------

Option Explicit

Private Sub cmdToonFormulier_Click()

    frmTekstvak.Show

End Sub

UserForm

'-----------------------------------------------------------------------------------------------------------------------
' Auteur        : pascalterheege.nl
' Datum         : 16-1-2016
' Object        : frmTekstvak
' Doel          : formulier voor het gevalideerd (max x regels) invullen van tekstvakken. Let op: de breedte van de
'                 tekstvakken in het Word-document dienen even breed te zijn als de tekstvakken van dit formulier
' Verwijzing    :
' Bron          :
'-----------------------------------------------------------------------------------------------------------------------
Option Explicit

Dim Tekstvak As New clsTekstvak

Const cstRegelMax1 = 4          'tekstvak 1 maximaal 4 regels
Const cstRegelMax2 = 12         'idem

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Subroutine
' Opmerking     : formulier beëindigen
'-----------------------------------------------------------------------------------------------------------------------
Private Sub cmdAnnuleren_Click()

    End

End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Subroutine
' Opmerking     : teksten in Word-document plaatsen
'-----------------------------------------------------------------------------------------------------------------------
Private Sub cmdOK_Click()

    With Tekstvak
        .Tekst1 = txtTekstvak1.Text
        .Tekst2 = txtTekstvak2.Text
    End With
    
    End

End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Subroutine
' Opmerking     : wanneer tekst wordt gewijzigd controleren op max regels
'-----------------------------------------------------------------------------------------------------------------------
Private Sub txtTekstvak1_Change()

    Tekstvak.valideerTekstvak lblTekstvak1, txtTekstvak1, cstRegelMax1

End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Subroutine
' Opmerking     : idem
'-----------------------------------------------------------------------------------------------------------------------
Private Sub txtTekstvak2_Change()

    Tekstvak.valideerTekstvak lblTekstvak2, txtTekstvak2, cstRegelMax2

End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Subroutine
' Opmerking     : bij activeren formulier teksten uit tekstvakken inlezen
'-----------------------------------------------------------------------------------------------------------------------
Private Sub UserForm_Activate()
    
    txtTekstvak1.Text = Tekstvak.Tekst1
    txtTekstvak2.Text = Tekstvak.Tekst2
    
    frmTekstvak1.SetFocus
    
End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Subroutine
' Opmerking     : meerdere regels en gebruik enter in tekstvakken
'-----------------------------------------------------------------------------------------------------------------------
Private Sub UserForm_Initialize()

    With txtTekstvak1
        .EnterKeyBehavior = True
        .MultiLine = True
    End With

    With txtTekstvak2
        .EnterKeyBehavior = True
        .MultiLine = True
    End With

End Sub

Klassenmodule

'-----------------------------------------------------------------------------------------------------------------------
' Auteur        : pascalterheege.nl
' Datum         : 16-1-2016
' Object        : clsTekstvak
' Doel          : aan de hand van range variabelen teksten uitlezen en plaatsen (document <> formulier)
' Verwijzing    :
' Bron          :
'-----------------------------------------------------------------------------------------------------------------------
Option Explicit

Dim rngTekstvak1 As Range
Dim rngTekstvak2 As Range

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Constructor
' Opmerking     : tekstvakken in document toekennen aan range variabelen
'-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Initialize()

    Set rngTekstvak1 = ActiveDocument.Shapes(1).TextFrame.TextRange
    Set rngTekstvak2 = ActiveDocument.Shapes(2).TextFrame.TextRange
    
End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Destructor
' Opmerking     : range variabelen leeg maken
'-----------------------------------------------------------------------------------------------------------------------
Private Sub Class_Terminate()

    Set rngTekstvak1 = Nothing
    Set rngTekstvak2 = Nothing

End Sub

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Property
' Opmerking     : tekstvak tekst exclusief paragraaf teken (paragraph mark)
'-----------------------------------------------------------------------------------------------------------------------
Property Get Tekst1() As String

    Tekst1 = Mid(rngTekstvak1, 1, Len(rngTekstvak1) - 1)

End Property

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Property
' Parameter     : Waarde
' Opmerking     : toekennen
'-----------------------------------------------------------------------------------------------------------------------
Public Property Let Tekst1(Waarde As String)

    rngTekstvak1 = Waarde

End Property

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Property
' Opmerking     : idem
'-----------------------------------------------------------------------------------------------------------------------
Property Get Tekst2() As String

    Tekst2 = Mid(rngTekstvak2, 1, Len(rngTekstvak2) - 1)

End Property

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Property
' Parameter     : Waarde
' Opmerking     : idem
'-----------------------------------------------------------------------------------------------------------------------
Public Property Let Tekst2(Waarde As String)

    rngTekstvak2 = Waarde

End Property

'-----------------------------------------------------------------------------------------------------------------------
' Datum         : 16-1-2016
' Type          : Subroutine
' Parameter     : lbl
' Parameter     : txt
' Parameter     : intRegelMax
' Opmerking     : methode t.b.v. validatie max regels!
'-----------------------------------------------------------------------------------------------------------------------
Sub valideerTekstvak(lbl As MSForms.Label, txt As MSForms.TextBox, intRegelMax As Integer)

    txt.SetFocus
    lbl.Caption = txt.LineCount & " van " & intRegelMax & " regels"
    
    If txt.LineCount > intRegelMax Then
        
        If Asc(Right(txt.Text, 1)) = 10 Then
            txt.Text = Mid(txt.Text, 1, Len(txt.Text) - 2) 'nieuwe regel m.b.v. enter = chr(10) en chr(13) = 2 karakters
        Else
            txt.Text = Mid(txt.Text, 1, Len(txt.Text) - 1) 'nieuwe regel (doorlopend)
        End If
        
    End If

End Sub

Download hier het oefenbestand.