Scribd Logo
Upload

Welcome to Scribd!

  • 45 views

    Macro

    Uploaded by

    ulp04
    This document contains VBA code for several subroutines: 1. SaveFileToPDF saves the active document as a PDF, setting bookmark colors before and after exporting. 2. RegKeyRead, RegKeySave, and RegKeyExists functions allow reading from, writing to, and checking existence of registry keys. 3. LinkToSourceFile links the active document to an Excel data source for mail merge fields. 4. AutoClose and AutoOpen macros configure mail merge settings on document close and open.

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd

    Macro

    Uploaded by

    ulp04
    45 views3 pages
    This document contains VBA code for several subroutines: 1. SaveFileToPDF saves the active document as a PDF, setting bookmark colors before and after exporting. 2. RegKeyRead, RegKeySave, and RegKeyExists functions allow reading from, writing to, and checking existence of registry keys. 3. LinkToSourceFile links the active document to an Excel data source for mail merge fields. 4. AutoClose and AutoOpen macros configure mail merge settings on document close and open.

    Original Description:

    VISUAL BASIC APPLICATION

    Copyright

    © © All Rights Reserved

    Available Formats

    TXT, PDF, TXT or read online from Scribd

    Did you find this document useful?

    Is this content inappropriate?

    This document contains VBA code for several subroutines: 1. SaveFileToPDF saves the active document as a PDF, setting bookmark colors before and after exporting. 2. RegKeyRead, RegKeySave, and RegKeyExists functions allow reading from, writing to, and checking existence of registry keys. 3. LinkToSourceFile links the active document to an Excel data source for mail merge fields. 4. AutoClose and AutoOpen macros configure mail merge settings on document close and open.

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    45 views3 pages

    Macro

    Uploaded by

    ulp04
    This document contains VBA code for several subroutines: 1. SaveFileToPDF saves the active document as a PDF, setting bookmark colors before and after exporting. 2. RegKeyRead, RegKeySave, and RegKeyExists functions allow reading from, writing to, and checking existence of registry keys. 3. LinkToSourceFile links the active document to an Excel data source for mail merge fields. 4. AutoClose and AutoOpen macros configure mail merge settings on document close and open.

    Copyright:

    © All Rights Reserved
    Download as TXT, PDF, TXT or read online from Scribd
    Download as txt, pdf, or txt
    of 3

    Sub SaveFileToPDF()

    Dim mypath As String


    Dim filewithoutext As String
    Dim strBook, strBookName As String
    mypath = ActiveDocument.FullName
    filewithoutext = Mid(mypath, InStrRev(mypath, "\") + 1, InStrRev(mypath, "."
    ) - InStrRev(mypath, "\") - 1)
    strBookName = filewithoutext & ".pdf"
    strBook = ActiveDocument.Path & "\berita_acara_online\" & strBookName
    ActiveDocument.Bookmarks("ttd").Range.Font.ColorIndex = wdWhite
    ActiveDocument.Bookmarks("ttd2").Range.Font.ColorIndex = wdWhite
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
    strBook, ExportFormat:= _
    wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
    wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
    Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
    CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=False, _
    BitmapMissingFonts:=True, UseISO19005_1:=False
    ActiveDocument.Bookmarks("ttd").Range.Font.ColorIndex = wdAuto
    ActiveDocument.Bookmarks("ttd2").Range.Font.ColorIndex = wdAuto
    End Sub
    'reads the value for the registry key i_RegKey
    'if the key cannot be found, the return value is ""
    Function RegKeyRead(i_RegKey As String) As String
    Dim myWS As Object
    On Error Resume Next
    'access Windows scripting
    Set myWS = CreateObject("WScript.Shell")
    'read key from registry
    RegKeyRead = myWS.RegRead(i_RegKey)
    End Function
    'sets the registry key i_RegKey to the
    'value i_Value with type i_Type
    'if i_Type is omitted, the value will be saved as string
    'if i_RegKey wasn't found, a new registry key will be created
    ' change REG_DWORD to the correct key type
    Sub RegKeySave(i_RegKey As String, _
    i_Value As String, _
    Optional i_Type As String = "REG_DWORD")
    Dim myWS As Object
    'access Windows scripting
    Set myWS = CreateObject("WScript.Shell")
    'write registry key
    myWS.RegWrite i_RegKey, i_Value, i_Type
    End Sub
    'returns True if the registry key i_RegKey was found
    'and False if not

    Function RegKeyExists(i_RegKey As String) As Boolean


    Dim myWS As Object
    On Error GoTo ErrorHandler
    'access Windows scripting
    Set myWS = CreateObject("WScript.Shell")
    'try to read the registry key
    myWS.RegRead i_RegKey
    'key was found
    RegKeyExists = True
    Exit Function
    ErrorHandler:
    'key was not found
    RegKeyExists = False
    End Function

    Option Explicit
    Sub LinkToSourceFile()
    Dim strBook As String
    Dim strBookName As String
    Dim strDataSource As String
    strBookName = "\dbpokja.xlsm"
    strBook = ActiveDocument.Path & strBookName
    strDataSource = ActiveDocument.MailMerge.DataSource.Name
    ActiveDocument.MailMerge.OpenDataSource Name:= _
    strBook, _
    ConfirmConversions:=False, _
    ReadOnly:=False, _
    LinkToSource:=True, _
    AddToRecentFiles:=False, _
    PasswordDocument:="", _
    PasswordTemplate:="", _
    WritePasswordDocument:="", _
    WritePasswordTemplate:="", _
    Revert:=False, _
    Format:=wdOpenFormatAuto, _
    Connection:= _
    "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=strBook;Mode=Read;E
    xtended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:
    Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:D", _
    SQLStatement:="SELECT * FROM `baku$`", _
    SQLStatement1:="", SubType:= _
    wdMergeSubTypeAccess
    End Sub
    Sub AutoClose()
    If Application.Version < 10 Then
    ActiveDocument.MailMerge.MainDocumentType = wdNotAMergeDocument
    End If

    ActiveDocument.Save
    End Sub
    Sub AutoOpen()
    LinkToSourceFile
    ActiveDocument.MailMerge.ViewMailMergeFieldCodes = wdToggle
    End Sub

    You might also like