VBA voor Word door Lenny Hoeks

1
VBA voor Worddoor Lenny Hoeks
2
Onderwerpen

• Sjablonen systemen
• gegevens bewaren in een ini-file
• macros in een externe file
• beveiliging sjablonen
• Sjablonen systemen gekoppeld aan databases
• invulvelden invoegen vanuit platte tekst
• velden verwijderen, koppeling normal
• custom document properties, ranges
• naam document instellen
• Documenten beheer
• macro buttons
• Functies in Word overnemen
• Standaarlettertype instellen, werken met klassen
• autoexec, autoclose
• DocumentBeforeClose

3
Gegevens in Ini file (1)

• AANTAL
• aantal6
• OFFICIEEL
• officieel1mevrouw Van den Berg
• officieel2mevrouw Demmers
• officieel3mevrouw Stuivenberg
• officieel4mevrouw Schermer
• officieel5mevrouw Van der Willik
• TELEFOON
• telefoon15 94
• telefoon26 03
• telefoon35 95
• telefoon46 18
• telefoon55 93

4
Gegevens in Ini file (2)

• Public Const strConsulenten1 As String
  "\DetacheringsConsulenten.txt"
• Dim strConsulenten As String
• Dim intI As Integer
• Dim strKeuze As String
• Sub ConsulentenLijst()
• strKeuze officieel"
• On Error Resume Next
• strConsulenten ActiveDocument.AttachedTemplate.P
  ath strConsulenten1
• ActiveDocument.FormFields(strKeuze).DropDown.ListE
  ntries.Clear
• With ActiveDocument.FormFields(strKeuze).DropDown.
  ListEntries
• For intI 1 To System.PrivateProfileString(st
  rConsulenten, "AANTAL", "aantal")
• .Add NameSystem.PrivateProfileString
  (strConsulenten, UCase(strKeuze),
  LCase(strKeuze) CStr(intI))
• Next intI
• End With
• End Sub

5
Gegevens in Ini file (3)

• Sub Telefoonlijst()
• On Error Resume Next
• strConsulenten ActiveDocument.AttachedTemplate.P
  ath strConsulenten1
• strKeuze "consulent"
• For intI 1 To System.PrivateProfileString(strCon
  sulenten, "AANTAL", "aantal")
• If ActiveDocument.FormFields(strKeuze).Res
  ult System.PrivateProfileString(strConsulenten,
  UCase(strKeuze), LCase(strKeuze) CStr(intI))
  Then Exit For
• Next intI
• strKeuze "telefoon"
• ActiveDocument.FormFields("telefoon").Result
  System.PrivateProfileString(strConsulenten,
  UCase(strKeuze), LCase(strKeuze) CStr(intI))
• ActiveDocument.Fields.Update
• End Sub

6
Beveiliging sjablonen

• Public Const PASWOORD As String Lynx"
• Sub BeveiligenDocument()
• ActiveDocument.Protect wdAllowOnlyFormFields,
  True, PASWOORD
• End Sub
• Sub BeveiligingErAf()
• ActiveDocument.Unprotect PASWOORD
• End Sub

7
Sjablonen met database

• Public dbMain As New ADODB.Connection
• Public rsTeksten As New ADODB.Recordset
• Public SQL As String
• Denk hierbij aan de ActiveX verwijzing
• welke verwijzing!!!

8
Sjablonen met database (2)

• 'Briefgegevens ophalen
• dbMain.Open "ProviderMicrosoft.Jet.OLEDB.4.0"
  _
• "Persist Security InfoFalse" _
• "Data Source" PLAATS_DATABASE
• SQL "SELECT FROM Teksten WHERE Briefnummer"
  _
• CInt(TekstInCell(docGegevens.Tables(2).Cell(2,
  2).Range.Text)) ""
• rsTeksten.Open SQL, dbMain, adOpenStatic,
  adLockReadOnly
• strTekst rsTeksten("Tekstfragment")
• strBijlage rsTeksten("Bijlage")
• strOndertekening rsTeksten("Ondertekening")
• blnAanhef rsTeksten("Aanhef")
• rsTeksten.Close
• dbMain.Close

9
Tekst in Database

• ltbgtArtikel 1gtgt3,0gtgtAanstellinglt/bgt
• ltngtDe aanstelling wordt gewijzigd met ingang van
  wijzigingsdatum .
• PlaatsWerkzaamheden is de plaats waar de
  werkzaamheden worden verricht. Werkgever houdt
  zich het recht voor genoemde plaats te
  wijzigen.lt/ngt

10
Invulvelden invoegen vanuit platte tekst (1)

• Dim strTekst As String
• Application.ScreenUpdating False
• InstellingenBehEnGebrui.ZoekinstellingenResetten
• 'TekstvakkenInvoegen
• ActiveDocument.Bookmarks("BeginDocument").Select
• Do While Zoeken("\\", , True) True
• strTekst Mid(Selection.Text, 2,
  Len(Selection.Text) - 2)
• Selection.FormFields.Add RangeSelection.Rang
  e, Type _
• wdFieldFormTextInput
• Selection.PreviousField.Select
• Selection.FormFields(1).TextInput.EditType
  TypewdRegularText, DefaultstrTekst
• Loop

11
Invulvelden invoegen vanuit platte tekst (2)

• Function Zoeken(Optional strZoekTekst As String
  "", _
• Optional strVervangTekst As String "", _
• Optional blnJokers As Boolean False, _
• Optional blnFormat As Boolean False, _
• Optional varWrap As Variant wdFindStop, _
• Optional varReplace As Variant
  wdReplaceNone) As Boolean
• With Selection.Find
• .Text strZoekTekst
• .Replacement.Text strVervangTekst
• .Wrap varWrap
• .Format blnFormat
• .MatchWildcards blnJokers
• End With
• Zoeken Selection.Find.Execute(ReplacevarReplac
  e)
• End Function

12
Invulvelden invoegen vanuit platte tekst (3)

• Sub ZoekinstellingenResetten()
• Selection.Find.ClearFormatting
• Selection.Find.Replacement.ClearFormatting
• With Selection.Find
• .Text ""
• .Replacement.Text ""
• .Forward True
• .Wrap wdFindStop
• .Format False
• .MatchCase False
• .MatchWholeWord False
• .MatchWildcards False
• .MatchSoundsLike False
• .MatchAllWordForms False
• End With
• Selection.Find.Execute ReplacewdReplaceNone
• End Sub

13
Velden verwijderen

• Sub BeveiligingErafEnOntkoppelen()
• On Error GoTo ErrHand
• ActiveDocument.Sections(3).Range.Fields.Unlink
• ActiveDocument.Unprotect
• ActiveDocument.AttachedTemplate Normal
• Exit Sub
• ErrHand
• MsgBox Err.Number vbNewLine _
• Err.Description, , TITLE
• End Sub

14
Custom Document Properties

• Sub CDPsMaken(strNaamDocument1 As String,
• strNaamCDP As String, varWaardeCDP As Variant, _
• Optional varTypeCDP As Variant
  msoPropertyTypeString)
• Documents(strNaamDocument1).CustomDocumentProperti
  es.Add _
• NamestrNaamCDP, LinkToContentFalse,
  ValuevarWaardeCDP, _
• TypevarTypeCDP
• End Sub
• CDPsMaken DocumentNaam, "Datum", "1-1-2000",
  msoPropertyTypeDate
• Documents(DocumentNaam).CustomDocumentProperties("
  Datum") Date
• CDPsMaken DocumentNaam, "Kenmerk",
  strKenmerkAchternaam
• Documents(DocumentNaam).CustomDocumentProperties("
  Kenmerk") rsTeksten("Omschrijving")

15
Ranges

• Dim rngDocument As Range
• Set rngDocument objDoc.Content
• rngDocument.SetRange StartobjDoc.Tables(objDoc.T
  ables.Count).Range.End, _
• EndrngDocument.End
• objSjabloon.Paragraphs(objSjabloon.Paragraphs.Coun
  t).Range.InsertAfter _
• vbNewLine vbNewLine Trim(rngDocument.Text
  )

16
Documentnaam voorstellen

• Als een document nog niet is opgeslagen, kun je
  eensuggestie geven voor de file naam in
  Bestand, Eigenschappen.
• ActiveDocument.BuiltInDocumentProperties(wdPropert
  yTitle) DocNaam"
• With Dialogs(wdDialogFileSummaryInfo)    .Title
  Titel Document"    .ExecuteEnd With
• om het pad te bepalen
• With Dialogs(wdDialogFileSaveAs)     .Name
  "c\windows\temp\"     .Show End With

17
Documentbeheer

• With Application.FileSearch
• .NewSearch
• .LookIn strMapnaam
• .SearchSubFolders False
• .FileName ".doc"
• If .Execute gt 0 Then
• For intI 1 To .FoundFiles.Count
• msgbox .FoundFiles(intI)
• Next intI
• Else
• MsgBox "Geen documenten gevonden."
• End If
• End with

18
Waarschuwingen uitzetten

• With Application
• .DisplayAlerts wdAlertsNone
• code
• .DisplayAlerts wdAlertsAll
• End With

19
Wordopdrachten ondervangen

• Sub FileClose()
• MsgBox "wordt afgesloten"
• End Sub

20
Pad vastleggen

• Sub FileSave() Dim UserSaveDialog As Dialog
  Set UserSaveDialog Dialogs(wdDialogFileSaveAs)
  als het document al ooit is opgeslagen, wordt
  het opgeslagen If ActiveDocument.Path ltgt "" Then
      ActiveDocument.Save     Exit Sub End If
  With UserSaveDialog     .Name "C\My
  Documents"     If .Display Then        If
  LCase(Left(CurDir, 15)) ltgt "c\my documents"
  Then            MsgBox U kunt het document hier
  niet opslaan., vbCritical, TITEL
•             Exit Sub        End If       
  opslaan van het document       
  UserSaveDialog.Execute    End IfEnd WithEnd
  Sub

21
Klasse declareren

• In Klasse Module (GebeurtenisKlasse2)
• Public WithEvents appWord as Word.Application

22
Event declareren

• In een module
• Dim X As New GebeurtenisKlasse2
• Sub Register_Event_Handler()
• Set X.App Word.Application
• End Sub
• Sub Autoexec()
• Register_Event_Handler
• End Sub

23
DocumentBeforeClose

• Private Sub App_DocumentBeforeClose(ByVal Doc As
  _
• Document, Cancel As Boolean)
• Select Case MsgBox("Het document " Doc.Name "
  wordt gesloten" vbNewLine "wilt u dat? ",
  vbYesNo, VBA Word")
• Case Is vbNo
• Cancel True
• Case Is vbYes
• ActiveDocument.Saved True
• SendKeys "N"
• End Select
• End Sub

24
Lettertype instellen

• Private Sub App_NewDocument(ByVal Doc As
  Document)
• Private Sub App_DocumentChange()
• ActiveDocument.Styles(wdStyleNormal).Font.Name
  "Comic Sans MS"
• End Sub

25
AutoClose

• Public Sub AutoClose() geef aan dat het
  document nog opgeslagen dient te worden er
  verschijnt dan een venster om het document op te
  slaan
•    ActiveDocument.Saved False    het
  document wordt niet opgeslagen of gesloten als er
  op annuleren wordt gedrukt...
•    SendKeys "ESC" End Sub

26
De Rooie Zebra

• Red Zebra denkt met u mee als het gaat over het
  vereenvoudigen en stroomlijnen van
  uw administratieve handelingen.
• Red Zebra realiseert dit middels de MS Office
  omgeving. Dat varieert van het professioneel
  opmaken van Word documenten en PowerPoint
  presentaties, tot het maken van sjablonen en
  huisstijl systemen in Word, bedrijfsspecifieke
  tools in Excel, documentbeheersing middels VBA.
• Het maken van databases en de koppeling hier
  naartoe kan ook gerealiseerd worden.
• Tevens verzorgt Red Zebra onderwijs in
  bovengenoemde disciplines.