260 likes | 527 Views
VBA voor Word door Lenny Hoeks. Onderwerpen. Sjablonen systemen gegevens bewaren in een ini-file macro’s in een externe file beveiliging sjablonen Sjablonen systemen gekoppeld aan databases invulvelden invoegen vanuit platte tekst velden verwijderen, koppeling normal
E N D
VBA voor Worddoor Lenny Hoeks Nationale Officedag
Onderwerpen Sjablonen systemen • gegevens bewaren in een ini-file • macro’s 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 Nationale Officedag
Gegevens in Ini file (1) • [AANTAL] • aantal=6 • [OFFICIEEL] • officieel1=mevrouw Van den Berg • officieel2=mevrouw Demmers • officieel3=mevrouw Stuivenberg • officieel4=mevrouw Schermer • officieel5=mevrouw Van der Willik • [TELEFOON] • telefoon1=5 94 • telefoon2=6 03 • telefoon3=5 95 • telefoon4=6 18 • telefoon5=5 93 Nationale Officedag
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.Path & strConsulenten1 • ActiveDocument.FormFields(strKeuze).DropDown.ListEntries.Clear • With ActiveDocument.FormFields(strKeuze).DropDown.ListEntries • For intI = 1 To System.PrivateProfileString(strConsulenten, "AANTAL", "aantal") • .Add Name:=System.PrivateProfileString(strConsulenten, UCase(strKeuze), LCase(strKeuze) & CStr(intI)) • Next intI • End With • End Sub Nationale Officedag
Gegevens in Ini file (3) • Sub Telefoonlijst() • On Error Resume Next • strConsulenten = ActiveDocument.AttachedTemplate.Path & strConsulenten1 • strKeuze = "consulent" • For intI = 1 To System.PrivateProfileString(strConsulenten, "AANTAL", "aantal") • If ActiveDocument.FormFields(strKeuze).Result = 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 Nationale Officedag
Beveiliging sjablonen • Public Const PASWOORD As String = “Lynx" • Sub BeveiligenDocument() • ActiveDocument.Protect wdAllowOnlyFormFields, True, PASWOORD • End Sub • Sub BeveiligingErAf() • ActiveDocument.Unprotect PASWOORD • End Sub Nationale Officedag
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!!! Nationale Officedag
Sjablonen met database (2) • 'Briefgegevens ophalen • dbMain.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _ • "Persist Security Info=False;" & _ • "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 Nationale Officedag
Tekst in Database • <b>Artikel 1>>3,0>>Aanstelling</b> • <n>De 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.</n> Nationale Officedag
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 Range:=Selection.Range, Type:= _ • wdFieldFormTextInput • Selection.PreviousField.Select • Selection.FormFields(1).TextInput.EditType Type:=wdRegularText, Default:=strTekst • Loop Nationale Officedag
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(Replace:=varReplace) • End Function Nationale Officedag
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 Replace:=wdReplaceNone • End Sub Nationale Officedag
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 Nationale Officedag
Custom Document Properties • Sub CDPsMaken(strNaamDocument1 As String, • strNaamCDP As String, varWaardeCDP As Variant, _ • Optional varTypeCDP As Variant = msoPropertyTypeString) • Documents(strNaamDocument1).CustomDocumentProperties.Add _ • Name:=strNaamCDP, LinkToContent:=False, Value:=varWaardeCDP, _ • Type:=varTypeCDP • End Sub • CDPsMaken DocumentNaam, "Datum", "1-1-2000", msoPropertyTypeDate • Documents(DocumentNaam).CustomDocumentProperties("Datum") = Date • CDPsMaken DocumentNaam, "Kenmerk", strKenmerkAchternaam • Documents(DocumentNaam).CustomDocumentProperties("Kenmerk") = rsTeksten("Omschrijving") Nationale Officedag
Ranges • Dim rngDocument As Range • Set rngDocument = objDoc.Content • rngDocument.SetRange Start:=objDoc.Tables(objDoc.Tables.Count).Range.End, _ • End:=rngDocument.End • objSjabloon.Paragraphs(objSjabloon.Paragraphs.Count).Range.InsertAfter _ • vbNewLine & vbNewLine & Trim$(rngDocument.Text) Nationale Officedag
Documentnaam voorstellen • Als een document nog niet is opgeslagen, kun je eensuggestie geven voor de file naam in Bestand, Eigenschappen. • ActiveDocument.BuiltInDocumentProperties(wdPropertyTitle) = “DocNaam" • With Dialogs(wdDialogFileSummaryInfo) .Title = “Titel Document" .ExecuteEnd With • ‘om het pad te bepalen • With Dialogs(wdDialogFileSaveAs) .Name = "c:\windows\temp\" .Show End With Nationale Officedag
Documentbeheer • With Application.FileSearch • .NewSearch • .LookIn = strMapnaam • .SearchSubFolders = False • .FileName = "*.doc" • If .Execute > 0 Then • For intI = 1 To .FoundFiles.Count • msgbox .FoundFiles(intI) • Next intI • Else • MsgBox "Geen documenten gevonden." • End If • End with Nationale Officedag
Waarschuwingen uitzetten • With Application • .DisplayAlerts = wdAlertsNone • ‘code • .DisplayAlerts = wdAlertsAll • End With Nationale Officedag
Wordopdrachten ondervangen • Sub FileClose() • MsgBox "wordt afgesloten" • End Sub Nationale Officedag
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 <> "" Then ActiveDocument.Save Exit Sub End If With UserSaveDialog .Name = "C:\My Documents" If .Display Then If LCase$(Left$(CurDir, 15)) <> "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 Nationale Officedag
Klasse declareren • In Klasse Module: (GebeurtenisKlasse2) • Public WithEvents appWord as Word.Application Nationale Officedag
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 Nationale Officedag
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 Nationale Officedag
Lettertype instellen • Private Sub App_NewDocument(ByVal Doc As Document) • Private Sub App_DocumentChange() • ActiveDocument.Styles(wdStyleNormal).Font.Name = "Comic Sans MS" • End Sub Nationale Officedag
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 Nationale Officedag
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. Nationale Officedag