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