急求守柔兄：如何在分页保存中使用第一行字串作为文件名呢？

FENGJUN · 发表于 2005-9-5 11:16

本帖最后由 kqbt 于 2012-7-11 21:48 编辑

急求守柔兄：我的文档每页第一行文字已确保有"xxx工资条"字串，如何在分页保存中使用这些字串作为相应的文件名呢？

http://club.excelhome.net/viewthread.php?tid=52690

分页保存代码确实极为实用，尤其在使用“邮件合并”的“合并到新文档”你又需要将其拆分......

[此贴子已经被作者于2005-9-5 11:20:29编辑过]

守柔 · 发表于 2005-9-5 16:58

以下是引用FENGJUN在2005-9-5 11:16:52的发言：
急求守柔兄：我的文档每页第一行文字已确保有"xxx工资条"字串，如何在分页保存中使用这些字串作为相应的文件名呢？

http://club.excelhome.net/viewthread.php?tid=52690

分页保存代码确实极为实用，尤其在使用“邮件合并”的“合并到新文档”你又需要将其拆分......

如果是“邮件合并”中的文档，再将其拆分，还不如用AUTOMATION方式进行，仍然以“主文档”的（带引号，不是真正的主文档）的方式进行写入数据后，另存为更方便（当然也用VBA）

请FENGJUN兄上传你的主文档和数据源示意附件，我看一下，以何种方式进行更好。

另请FENGJUN兄给我一点时间，我最近很忙，尽早完成，尽量一步到位吧，主要看一下附件。

守柔 · 发表于 2005-9-6 05:12

这是一个根据用户指定任意分页数的分页保存代码，请FENGJUN兄测试一下：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-9-6 5:12:45
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'№ 0005^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit
Sub SaveAsPages()
    Dim NumberPages As Integer, SAP As Byte, i As Integer
    Dim lngStart As Long, lngEnd As Long, myRange As Range
    Dim NewDoc As Document, FilName As String
    On Error GoTo Errhandle    '错误处理
Start:     SAP = VBA.InputBox("请输入每个文件的分页数", "ExcelHome")
    With ThisDocument
        '取得本文档的总页数
        NumberPages = .Content.Information(wdNumberOfPagesInDocument)
        '如果分页值大于总页数或者为0的整数则进入错误处理行
        If SAP > NumberPages Or SAP = 0 Then GoTo Errhandle
        Application.ScreenUpdating = False    '关闭屏幕更新
        For i = 1 To NumberPages Step SAP    '进行一个循环
            '取得第一个分页的起始位置
            lngStart = .GoTo(wdGoToPage, wdGoToNext, , i).Start
            '取得第一个分页的最后位置(是下一页的开始位置)
            lngEnd = VBA.IIf(i + SAP > NumberPages, .Content.End, .GoTo(wdGoToPage, wdGoToNext, , i + SAP).Start)
            '定义一个RANGE对象
            Set myRange = .Range(lngStart, lngEnd)
            '            myRange.Select
            '取得文件名,为该RANGE区域中的第一个段落文本(去除段落标记)
            FilName = .Range(myRange.Paragraphs(1).Range.Start, myRange.Paragraphs(1).Range.End - 1)
            Set NewDoc = Documents.Add    '新建一个空白文档
            myRange.Copy    '复制
            With NewDoc
                .Range(0, 0).Paste    '起点处粘贴
                .Paragraphs.Last.Range.Delete    '删除最后一个段落标记(看情况)
                .SaveAs FilName    '另存为
                .Close    '关闭该文档
            End With
        Next
    End With
    Application.ScreenUpdating = True    '恢复屏幕更新
    Exit Sub
Errhandle:
    MsgBox "无效的分页数,请输入正确的数值!", vbExclamation, "ExcelHome"
    Application.ScreenUpdating = True
End Sub
'----------------------

[此贴子已经被konggs于2008-8-23 10:30:31编辑过]

FENGJUN · 发表于 2005-9-6 09:48

守柔兄：我的主文档中会有很多处使用域来引用数据源中的数据，而且在将来使用中会经常增删这些域，所以我想还是采用邮件合并更灵活，“自动化”代码修改起来会麻烦得多呀。

兄台的“分页保存”代码对我非常有意义。

—————————————————————————————————— 经测试，3楼代码在输入分页数为1后即转为错误处理，让我莫名其妙，原因是什么呢？

fFkcT4fJ.rar (15.87 KB, 下载次数: 93)

[此贴子已经被作者于2005-9-6 9:59:37编辑过]

守柔 · 发表于 2005-9-6 11:01

TO FENGJUN兄

我的这个程序仅对普通文档起作用，如果是邮件合并的合并文档，则需要调整，另外，我看了一个，你的合并文档（即附件），设计时好象有违常理，能否把主文档传上来，我看一下，配合程序，修改一下。

另外，出错的原因是因为文件名中带有分页符（分节符）所致。

[此贴子已经被作者于2005-9-6 11:03:07编辑过]

FENGJUN · 发表于 2005-9-6 13:10

守柔兄：

请看主文档和数据源文件：

MSHj3sx4.rar (22.74 KB, 下载次数: 66) 顺便问个相关问题：设置成“12.25%”这样的百分比数字格式的域开关该怎么写呢？

[此贴子已经被作者于2005-9-6 13:55:01编辑过]

守柔 · 发表于 2005-9-6 13:58

对于6楼的附件，我修改了一下代码，4楼的主文档，请按6楼一致的样式。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋ '* Created By I Love You_Word!@ExcelHome 2005-9-6 13:58:50 '仅测试于System: Windows NT Word: 10.0 Language: 2052 '№ 0007^The Code CopyIn [ThisDocument-ThisDocument]^' '* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit Sub SaveAsPages() Dim NumberPages As Integer, SAP As Byte, i As Integer Dim lngStart As Long, lngEnd As Long, myRange As Range Dim NewDoc As Document, FilName As String On Error GoTo Errhandle '错误处理 SAP = VBA.InputBox("请输入每个文件的分页数", "ExcelHome", Default:=1) With ThisDocument '取得本文档的总页数 NumberPages = .Content.Information(wdNumberOfPagesInDocument) 'MsgBox NumberPages '如果分页值大于总页数或者为0的整数则进入错误处理行 If SAP > NumberPages Or SAP = 0 Then GoTo Errhandle Application.ScreenUpdating = False '关闭屏幕更新 '将分节符替换为分页符 .Content.Find.Execute findtext:="^b", Replacewith:="^m", Replace:=wdReplaceAll For i = 1 To NumberPages Step SAP '进行一个循环 '取得第一个分页的起始位置 lngStart = .GoTo(wdGoToPage, wdGoToNext, , i).Start '取得第一个分页的最后位置(是下一页的开始位置) lngEnd = VBA.IIf(i + SAP > NumberPages, .Content.End, .GoTo(wdGoToPage, wdGoToNext, , i + SAP).Start) '定义一个RANGE对象 Set myRange = .Range(lngStart, lngEnd) myRange.Select '取得文件名,为该RANGE区域中的第一个段落文本(去除段落标记) FilName = .Range(myRange.Paragraphs(1).Range.Start, myRange.Paragraphs(1).Range.End - 1) Set NewDoc = Documents.Add '新建一个空白文档 myRange.Copy '复制 With NewDoc .Range(0, 0).Paste '起点处粘贴 .Paragraphs.Last.Range.Delete '删除最后一个段落标记(看情况) ' Debug.Print FilName .SaveAs FilName '另存为 .Close '关闭该文档 End With Next End With Application.ScreenUpdating = True '恢复屏幕更新 Exit Sub Errhandle: MsgBox "无效的分页数,请输入正确的数值!", vbExclamation, "ExcelHome" Application.ScreenUpdating = True End Sub '----------------------

最后一页也许会出错，因为是空白段落，我没有写进去，因为，如果不是合并文档，不存在此问题。

域代码为: { =10 \# "0%" }=10%

你再试一下。

FENGJUN · 发表于 2005-9-6 15:26

守柔兄： 7楼代码在对普通文档分页时没问题。但针对附件文档：代码在分离第2页时退出（请见附件1）。附件1： SCqeZvVE.rar (12.29 KB, 下载次数: 45)

[此贴子已经被作者于2005-9-6 15:31:16编辑过]

守柔 · 发表于 2005-9-6 16:34

TO FENGJUN兄：

今天我好象老出错似的。明明代码已经修改，怎么粘贴的还是老代码？[em06]

请参：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-9-6 16:31:10
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'№ 0003^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Option Explicit
Sub SaveAsPages()
    Dim NumberPages As Integer, SAP As Byte, i As Integer
    Dim lngStart As Long, lngEnd As Long, myRange As Range
    Dim NewDoc As Document, FilName As String
    On Error GoTo Errhandle    '错误处理
    SAP = VBA.InputBox("请输入每个文件的分页数", "ExcelHome", Default:=1)
    With ThisDocument
        '取得本文档的总页数
        NumberPages = .Content.Information(wdNumberOfPagesInDocument)
        'MsgBox NumberPages
        '如果分页值大于总页数或者为0的整数则进入错误处理行
        If SAP > NumberPages Or SAP = 0 Then GoTo Errhandle
        Application.ScreenUpdating = False    '关闭屏幕更新
        '将分节符替换为分页符
        .Content.Find.Execute findtext:="^b", Replacewith:="^m", Replace:=wdReplaceAll
        For i = 1 To NumberPages Step SAP    '进行一个循环
            '取得第一个分页的起始位置
            lngStart = .GoTo(wdGoToPage, wdGoToNext, , i).Start
            '取得第一个分页的最后位置(是下一页的开始位置)
            lngEnd = VBA.IIf(i + SAP > NumberPages, .Content.End, .GoTo(wdGoToPage, wdGoToNext, , i + SAP).Start)
            '定义一个RANGE对象
            Set myRange = .Range(lngStart, lngEnd)
            '            myRange.Select
            '取得文件名,为该RANGE区域中的第一个段落文本(去除段落标记)
            FilName = .Range(myRange.Paragraphs(1).Range.Start, myRange.Paragraphs(1).Range.End - 1)
            FilName = VBA.Replace(FilName, Chr(12), "")    '删除分页符标记
            Set NewDoc = Documents.Add    '新建一个空白文档
            myRange.Copy    '复制
            With NewDoc
                .Range(0, 0).Paste    '起点处粘贴
                .Paragraphs.Last.Range.Delete    '删除最后一个段落标记(看情况)
                '                                Debug.Print FilName
                .SaveAs FilName    '另存为
                .Close    '关闭该文档
            End With
        Next
    End With
    Application.ScreenUpdating = True    '恢复屏幕更新
    Exit Sub
Errhandle:
    MsgBox "无效的分页数,请输入正确的数值!", vbExclamation, "ExcelHome"
    Application.ScreenUpdating = True
End Sub
'----------------------

' FilName = VBA.Replace(FilName, Chr(12), "") '删除分页符标记
域代码可使用如:注意用CTRL+f9插入域标志

域代码为: { ={ MERGEFIELD "第3季度任务数已完成比例" }*100 \#"00.00%" }

[此贴子已经被konggs于2008-8-23 10:32:43编辑过]

FENGJUN · 发表于 2005-9-7 14:05

守柔兄：

代码通过！生成60家分公司的分页文档顷刻完工！这通常是1个家伙耗费1整天的时间所要完成的事情啊！这真是从未有过的针对合并文档进行分页的完美的解决办法！

另：我还是不会插入百分比项目的域代码，再求兄台！

jutb8rOf.rar (19.15 KB, 下载次数: 179)

[此贴子已经被作者于2005-9-7 14:06:20编辑过]

		自动登录	找回密码
密码			免费注册

[已解决] 急求守柔兄：如何在分页保存中使用第一行字串作为文件名呢？