用于在Word 2010中的命令按钮(ActiveX)中导出为pdf的VB脚本

时间:2013-05-08 16:14:03

标签: vba word-vba word-2010 export-to-pdf commandbutton

好的,所以我有这个Word 2010 Macro启用的模板,上面有人们可以填写的方便的花花公子表格。我创建了一个“转换为PDF”的按钮,因为人们不知道如何在本地进行操作。我进入了我希望拥有此功能的特定CommandButton的VB编辑器。这是按钮中的最新信息:

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

当我运行代码时,我得到了...... BAM!编译错误:预期结束子

如果我取出Sub Convert_PDF()及其相关的End Sub,突然我没有收到子错误消息,但是我收到另一条错误消息:

The file [file name] cannot be opened beacause there are problems with the contents. Details: The file is corrupt and cannot be opened.用文件的实际名称替换[文件名]。

我会完全诚实,我是VB的完整版本,谷歌到目前为止还不是很有帮助:/

有什么见解?

2 个答案:

答案 0 :(得分:2)

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

答案 1 :(得分:0)

您的后续问题:

这取决于你如何选择约会。如果您从“日期选择器内容控件”中选择,那么您需要遵循以下代码。如果您从Active X“组合框”中选择,那么您需要从下拉框中提取它的值[January]msgbox(DropDown.Value)会显示"January。如果您需要将月份转换为数字[if DropDown.Value) = "January" Then...],则可以将其放在if语句中。

以下代码用于从单词

中的“日期选择器内容控件”中获取数据
'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