求助自动提取文号和标题另存为

dzhdj

求助各位大神，一般的公文都有文号和标题，怎样实现保存的时候自动提取文号加标题保存。

思路可以是：把文号设成”样式1“，标题设成”样式2“，另存的时候自动获取样式1和样式2的内容保存。

谢谢！

pureshadow

将内容和格式设置好以后，选取该段落，将其保存到文档部件库，记得存在normal里
以后要用的时候，直接调用自动图文集即可

dzhdj

补充一下，word2003版，最好用宏代码实现

dzhdj

pureshadow 发表于 2017-9-22 14:11
将内容和格式设置好以后，选取该段落，将其保存到文档部件库，记得存在normal里
以后要用的时候，直接调用 ...

不是保存在自动图文集，而是另存为文件的时候自动获取文号和标题存盘

duquancai

dzhdj 发表于 2017-9-22 17:33
不是保存在自动图文集，而是另存为文件的时候自动获取文号和标题存盘

没附件，没模拟结果，都是白说

dzhdj

要自动获取文号加标题，不用手动输入文件名称保存

duquancai

dzhdj 发表于 2017-9-23 14:40
要自动获取文号加标题，不用手动输入文件名称保存

你不提供附件！！！，写一个代码给你：
Sub shishi()
    Dim nstr$, bstr$, Myname$, d As Document
    Set d = ActiveDocument
    With d.Range(0, 0)
        .MoveWhile "　 " & ChrW(160) & Chr(13) & Chr(11) & Chr(10)
        .MoveEndUntil Chr(13): nstr = .Text: .Collapse 0
        .MoveWhile "　 " & ChrW(160) & Chr(13) & Chr(11) & Chr(10)
        .MoveEndUntil Chr(13): bstr = .Text
    End With
    Myname = GetName(nstr & bstr)
    d.SaveAs d.Path & "\" & Myname & ".doc", wdFormatDocument
    MsgBox "已另存到当前文档同目录下！"
End Sub
Function GetName(ByVal aStr As String) As String
    Dim ErrArray() As Variant, oArray As Variant
    ErrArray = Array("\", "/", "*", ":", "?", "<", ">", "|", """", Chr$(7), Chr$(8), Chr$(9), Chr$(10), Chr$(11), Chr$(13))
    For Each oArray In ErrArray
        aStr = Replace(aStr, oArray, "")
    Next
    GetName = LTrim(aStr)
End Function

dzhdj

duquancai 发表于 2017-9-23 15:43
你不提供附件！！！，写一个代码给你：
Sub shishi()
    Dim nstr$, bstr$, Myname$, d As Document

川电发〔2017〕33号 四川省×××××关于进一步加强2017年安全生产工作的通知.zip (7.75 KB, 下载次数: 6)

2017-9-24 14:41 上传

点击文件名下载附件

谢谢，此代码是直接保存的。
有点小问题：1．如果正文标题有二行或更多就不行了。2．能不能有选择路径框出来，自己选择存盘位置。

duquancai

dzhdj 发表于 2017-9-24 14:25
谢谢，此代码是直接保存的。
有点小问题：1．如果正文标题有二行或更多就不行了。2．能不能有选择 ...

不行算了，很抱歉，没兴趣了。。。。。。

wdpfox

学习一下，多谢杜老师慷慨分享好资料！
　　　　　　Oooo
　　　　　　(___)
　　oooO  　 )_/
　　(___) 　 (_/
　　 \_(
　　　\_)