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

守柔

FENGJUN兄，谈不上求啊，折煞守某也。

若非不细致，看不出你的域代码错在何处！

注意，你的等于号写错了，你用的是全角等于号（＝），应该是半角等于号啊（=）！，呵呵。

FENGJUN

真是好事多磨！ 理当感谢兄台呀！

由上面的需求可见，本人Word VBA是非得深入学习不可了。 顺便说一句，《守柔WORD编程代码集》是1本出色的教程。

[此贴子已经被作者于2005-9-7 15:00:30编辑过]

FENGJUN

守柔兄：

使用9楼的代码对附件进行分页面操作后出现以下两个新问题：

1、页眉消失了； 2、页面最末的横线只省下了半截儿。 如何处理这两种情况呢？

7aI5yMdI.rar (17.45 KB, 下载次数: 46)

2005-9-8 10:57 上传

点击文件名下载附件
急求守柔兄：如何在分页保存中使用第一行字串作为相应的文件名呢？

守柔

TO FENGJUN兄：

以下代码的意思是设置文档的页眉：

Sub Example() With ActiveDocument.Sections(1).Headers(wdHeaderFooterPrimary).Range .Text = "xxx¹«Ë¾Îļþ ÎļþºÅ£ºB006-[2005]0902" .Font.Bold = True .Font.Name = "ËÎÌå" .Font.Size = 11 .ParagraphFormat.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle End With With ActiveDocument.PageSetup .LeftMargin = Word.CentimetersToPoints(2.12) .RightMargin = Word.CentimetersToPoints(2.12) End With End Sub 请把它加在 .SaveAs ThisDocument.Path & "\" & FilName 这句代码之前，并用NEWDOC代替ACTIVEDOCUMENT。

至于半条线，请在主文档中重新设置，设置段落下边框线更好，不要用空格和下划线，因为空格在换行过程中，有变化。

FENGJUN

守柔兄： 我想用模板解决这个问题。 分页代码在《待分页文档2.doc》中，最后的签署日期为什么总是总是被删除掉？是否是因为 .Paragraphs.Last.Range.Delete '这一句呢？ 但如果将上句注销掉，则又会出现将签署日期分到下一文件的情况。

Dhvs75v1.rar (22.55 KB, 下载次数: 89)

2005-9-9 12:59 上传

点击文件名下载附件
急求守柔兄：如何在分页保存中使用第一行字串作为相应的文件名呢？

[此贴子已经被作者于2005-9-9 13:00:58编辑过]

FENGJUN

请守柔兄就15楼问题再出援手...

[此贴子已经被作者于2005-9-12 9:29:44编辑过]

守柔

以下是引用FENGJUN在2005-9-12 9:27:16的发言：
请守柔兄就15楼问题再出援手...

以下代码是完全按15楼的问题设计的，请再行测试。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-9-13 4:27:39
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'№ 00017^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.Right(FilName, Len(FilName) - InStr(FilName, Chr(12)))
            Debug.Print FilName
            '根据模板新建一个空白文档
            Set NewDoc = Documents.Add(Template:= _
                                       ThisDocument.Path & "\分公司《2005年9月任务预算表》_模板.dot" _
                                       , NewTemplate:=False, DocumentType:=0)
            myRange.Copy    '复制
            With NewDoc
                .Range(0, 0).Paste    '起点处粘贴
                '如果最后第二个字符为分页符(CHR(12))则删除之
                If Asc(.Characters.Last.Previous(1)) = 12 Then .Characters.Last.Previous(1).Delete
                .SaveAs ThisDocument.Path & "\" & FilName    '另存为
                .Close    '关闭该文档
            End With
        Next
    End With
    Application.ScreenUpdating = True    '恢复屏幕更新
    Exit Sub
Errhandle:
    MsgBox "Word出错的可能原因是:" & vbCrLf & "无效的分页数,请输入正确的数值!" & _
           vbCrLf & "非法的文件名!", vbExclamation, "ExcelHome"
    Application.ScreenUpdating = True
End Sub
'----------------------另外，你的模板中，不应该使用大量的空格键作为字符位置的填充，使用制表位或者表格，更有利于字符位置的分隔与固定。

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

FENGJUN

守柔兄： 完美的运行结果！

办公之星

二位论道，有如天外来客，呵呵。

kpjc

高手示范,获益良多,多来必有收获！守柔兄确实系高手！