问题描述
我尝试导出每个"title1"样式段落为pdf文件，其中title1文本为文件名，但我总是得到一个"不正确的文件名"。即使标题是"text1"
I try to export each "title1" style paragraph into a pdf file with the title1 text as filename but I always get a "incorrect filename " even when the title is "text1"
Sub ExportTitle1（）
'
'ExportTitle1 Macro
Selection.Find.Execute
Dim Title1Array（100）As Long
Dim TitleTxtArray（100）As String
icount = 1
'转到文档顶部
Selection.GoTo什么：= wdGoToPage，其中：= wdGoToNext，名称：=" 1"
'搜索标题1
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles（" Titre 1"）
Selection.Find.Execute
'icount< 1000只是在无限循环的情况下
选择时，Selection.Find.Found = True和icount< 1000
Title1Array（icount）= Selection.Information（wdActiveEndPageNumber）'当前页面为
TitleTxtArray（icount）= Selection.text'curent title
Selection.Find.Execute'搜索下一个标题1
icount = icount + 1
循环
Dim title As String
Dim pagestart As Long
Dim pagesEnd Long Long $
对于i = 1到icount
pagestart = Title1Array（i）
nexti = i + 1
pagesEnd = Title1Array（nexti） - 1'页面结束（下一个标题1页） - 1
title = ActiveDocument.Path& " \" &安培; TitleTxtArray（i）& " .pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName：= _
title，ExportFormat：= wdExportFormatPDF，_
OpenAfterExport：= False，OptimizeFor：= wdExportOptimizeForPrint，Range：= _
wdExportFromTo，From：= pagestart，To：= pagesEnd，Item：= wdExportDocumentContent，_
IncludeDocProps：= True，KeepIRM：= False，CreateBookmarks：= _
wdExportCreateHeadingBookmarks，DocStructureTags：= True，_
BitmapMissingFonts：= False，UseISO19005_1：= False
接下来我是
&NBSP;&NBSP;
结束子
Sub ExportTitle1()
'
' ExportTitle1 Macro
Selection.Find.Execute
Dim Title1Array(100) As Long
Dim TitleTxtArray(100) As String
icount = 1
'go to top of document
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="1"
'search for title 1
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Titre 1")
Selection.Find.Execute
'icount < 1000 just in case of infinite loop
Do While Selection.Find.Found = True And icount < 1000
Title1Array(icount) = Selection.Information(wdActiveEndPageNumber) 'current page
TitleTxtArray(icount) = Selection.text 'curent title
Selection.Find.Execute 'search next title1
icount = icount + 1
Loop
Dim title As String
Dim pagestart As Long
Dim pagesEnd As Long
For i = 1 To icount
pagestart = Title1Array(i)
nexti = i + 1
pagesEnd = Title1Array(nexti) - 1 'page end is (next title1 page) - 1
title = ActiveDocument.Path & "\" & TitleTxtArray(i) & ".pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
title, ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
wdExportFromTo, From:=pagestart, To:=pagesEnd, Item:=wdExportDocumentContent, _
IncludeDocProps:=True, KeepIRM:=False, CreateBookmarks:= _
wdExportCreateHeadingBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=False, UseISO19005_1:=False
Next i
End Sub
你能帮我吗？
推荐答案
TitleTxtArray（icount）= Selection.text'curent title
TitleTxtArray(icount) = Selection.text 'curent title
to
TitleTxtArray（icount）= Left（Selection.Text，Len（Selection.Text） - 1）'当前标题
TitleTxtArray(icount) = Left(Selection.Text, Len(Selection.Text) - 1) 'current title
2。您没有指定文档的最后一页，因此最后一次导出失败。
2. You don't specify the last page of the document, so the last export fails.
试试这个版本：
Sub ExportTitle1（）
'
'ExportTitle1 Macro
Dim Title1Array（）As Long
Dim TitleTxtArray（）As String
Dim icount As Long
Dim i As Long
Dim title As String
Dim pagestart As Long
Dim pagesEnd As Long
Sub ExportTitle1()
'
' ExportTitle1 Macro
Dim Title1Array() As Long
Dim TitleTxtArray() As String
Dim icount As Long
Dim i As Long
Dim title As String
Dim pagestart As Long
Dim pagesEnd As Long
'转到文档顶部
Selection.HomeKey单位：= wdStory
'go to top of document
Selection.HomeKey Unit:=wdStory
'搜索标题1
使用Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles（" Titre 1"）
Do While .Execute
icount = icount + 1
ReDim Preserve Title1Array（1至icount）
Title1Array（icount）= Selection.Information（wdActiveEndPageNumber）'当前页面¥b $ b ReDim Preserve TitleTxtArray（1至icount）
TitleTxtArray（icount）= Left（Selection.Text，Len（Selection.Text） - 1）'当前标题
循环'搜索下一个标题1
结束与$
'文件结尾
ReDim Preserve Title1Array（1至icount + 1）
'将最后一个值设置为页数+ 1，以便在循环中减去1的次数
Title1Array（icount + 1）= Selection.Information（wdNumberOfPagesInDocument）+ 1
'search for title 1
With Selection.Find
.ClearFormatting
.Style = ActiveDocument.Styles("Titre 1")
Do While .Execute
icount = icount + 1
ReDim Preserve Title1Array(1 To icount)
Title1Array(icount) = Selection.Information(wdActiveEndPageNumber) 'current page
ReDim Preserve TitleTxtArray(1 To icount)
TitleTxtArray(icount) = Left(Selection.Text, Len(Selection.Text) - 1) 'current title
Loop 'search next title1
End With
' End of document
ReDim Preserve Title1Array(1 To icount + 1)
' Set last value to number of pages + 1, to account for subtracting 1 in the loop
Title1Array(icount + 1) = Selection.Information(wdNumberOfPagesInDocument) + 1
对于i = 1到icount
pagestart = Title1Array（i）
pagesEnd = Title1Array（i + 1） - 1'页面结束（下一个标题1页） - 1个
title = ActiveDocument.Path& " \" &安培; TitleTxtArray（i）& " .pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName：= title，_
ExportFormat：= wdExportFormatPDF，_
OpenAfterExport：= False，OptimizeFor：= wdExportOptimizeForPrint，_
范围：= wdExportFromTo，From：= pagestart，To：= pagesEnd，_
Item：= wdExportDocumentContent，IncludeDocProps：= True，KeepIRM：= False，_
CreateBookmarks：= wdExportCreateHeadingBookmarks，BitmapMissingFonts：= False
接下来我是
结束子
For i = 1 To icount
pagestart = Title1Array(i)
pagesEnd = Title1Array(i + 1) - 1 'page end is (next title1 page) - 1
title = ActiveDocument.Path & "\" & TitleTxtArray(i) & ".pdf"
ActiveDocument.ExportAsFixedFormat OutputFileName:=title, _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportFromTo, From:=pagestart, To:=pagesEnd, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=False, _
CreateBookmarks:=wdExportCreateHeadingBookmarks, BitmapMissingFonts:=False
Next i
End Sub
这篇关于将每章（标题1）导出为单独的pdf的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！