Private Sub CommandButton1_Click()
Convert_PDF
End Sub
Sub Convert_PDF()
Dim desktoploc As String
Dim filename As String
Dim mypath As String
desktoploc = CreateObject("WScript.Shell").SpecialFolders("Desktop")
filename = ThisDocument.Name
mypath = desktoploc & "\" & filename & ".pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
mypath, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub
VB script to export to pdf in Command Button (ActiveX) in Word 2010
-
14-04-2022 - |
Domanda
Ok, so I have this Word 2010 Macro enabled template with my handy dandy forms that people can fill out. I have created a button that says "Convert to PDF" because people dont know how to do it natively. I entered the VB editor of the particular CommandButton that I want to have this functionality. Here's whats in that button:
Private Sub CommandButton1_Click()
Sub Convert_PDF()
Dim desktoploc As String
Dim filename As String
Dim mypath As String
desktoploc = CreateObject("WScript.Shell").SpecialFolders("Desktop")
filename = ThisDocument.Name
mypath = desktoploc & "\" & filename
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
mypath, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
End Sub
End Sub
When I run the code I get..... BAM! Compile error: Expected End Sub
If I take out the Sub Convert_PDF() and its pertaining End Sub, suddenly i dont get the sub error messages, but I get another error message:
The file [file name] cannot be opened beacause there are problems with the contents. Details: The file is corrupt and cannot be opened.
Replace [file name] with my file's actual name.
I'll be completely honest, I'm a complete n00b at VB and Google is turning out to not being very helpful thus far :/
Any insight?
Soluzione
Altri suggerimenti
For your follow up question:
It depends on how you're picking your date. If you're picking from a "Date Picker Content Control" then you'll need to follow the below code. If you're picking from an Active X "combo box" then you'll need to pull it's value [January]
from the dropdown box. msgbox(DropDown.Value)
will show "January
. You could put it in an if statement if you need to convert the month to a number [if DropDown.Value) = "January" Then...]
.
The below code is for getting the data from the "Date Picker Content Control" in word
'put this at the top of the code, outside any functions/subs
Dim DateGlobal As Date
'This sub will run whenever you exit any ContentControl function
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If IsDate(ActiveDocument.SelectContentControlsByTitle("Date").Item(1).Range.Text) = True Then
DateGlobal = ActiveDocument.SelectContentControlsByTitle("Date").Item(1).Range.Text
End If
'Now use DateGlobal wherever you need it; it will be in date format.
msgbox(DateGlobal) 'Shows date as default date format
msgbox(myDateFormat(DateGlobal) 'Shows date as your custom date format (below)
End Sub
'************************************************************************************
' Custom DATE format (instead of computer default)
' Found elsewhere on this site, I like my format yyyy/mm/dd
'************************************************************************************
Function myDateFormat(myDate)
d = WhatEver(Day(myDate))
M = WhatEver(Month(myDate))
y = Year(myDate)
myDateFormat = y & "/" & M & "/" & d
End Function
Function WhatEver(num)
If (Len(num) = 1) Then
WhatEver = "0" & num
Else
WhatEver = num
End If
End Function