请教大家一个word问题，怎样把word中第一行改为该文件的文件名

ivyjody

请教大家一个word问题，怎样把word中第一行改为该文件的文件名

论坛中都有把文件名改为word第一行的文章

但找不到把word的第一行改为word的文件名的文章

希望大家帮忙，版主救命啊

守柔

第一行还是第一个段落？

文档的第一行总是非空行？

ivyjody

是的，版主

ivyjody

版主，我的文件名批量改好了，就是想把文件名替换为word第一行的文字

wdwc

Sub a()
    Selection.HomeKey unit:=wdStory
    Selection.TypeText ActiveDocument.Name
    Selection.InsertParagraphAfter
End Sub

ivyjody

因为原来的word第一行比如"2006年广东模拟题"，文件名也是2006年广东模拟题

我批量改为"2007年广东模拟题"，但word第一行还是2006的，希望能批量来改

希望版主帮忙

我看了版主做的一个宏，刚好是相反的效果，自己也不知道怎么改那程序

希望版主救命

ivyjody

Sub NewNameWithDocuments()
    Dim MyDialog As FileDialog, oDoc As Variant, myDoc As Document
    Dim myRange As Range, oldName As String, ErrArray() As Variant
    Dim oArray As Variant, newName As String
    On Error Resume Next    '忽略错误
    '定义一个导致文件名出错的数组
    ErrArray = Array("\", "/", "*", "?", "<", ">", "|", """", Chr(9), Chr(11), Chr(13))
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show <> -1 Then Exit Sub
        For Each oDoc In .SelectedItems    '在所有选取项目中循环
            newName = ""
            '以隐藏方式打开Word文档
            Set myDoc = Word.Documents.Open(FileName:=oDoc, Visible:=False)
            Set myRange = myDoc.Paragraphs.First.Range '取得第1个段落区域
            oldName = Application.CleanString(myRange.Text) '清除非打印字符
            For Each oArray In ErrArray '遍历替换
                oldName = Replace(oldName, oArray, "")
            Next
            myDoc.Close False '关闭文档
            If Len(oldName) < 1 Then '如果长度小于1不处理
            Else '进行重命名操作
                newName = .InitialFileName & oldName & ".doc"
                '如果当前文件夹中没有此文件名
                If Dir(newName, vbDirectory) = "" Then
                    Name oDoc As newName '直接命名
                Else '如果存在,则按时间序列数加命名
                    newName = Replace(newName, ".doc", "")
                    newName = newName & Timer
                    newName = Replace(newName, ".", "")
                    newName = newName & ".doc"
                    Name oDoc As newName
                End If
            End If
        Next
    End With
End Sub

这是版主的程序，我不知怎么改才能有我要的效果，就是用文件名来替换word第一行文字

ivyjody

版主，是用文件名来换掉word第一行文字，

程序应该在你的那个程序的基础上怎么改动呢

请帮忙

ivyjody

文档的第一行，而且第一行总非空，

守柔

请参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2008-3-19 17:41:02
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0363^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit

Sub Example()
    Dim MyDialog As FileDialog, oDoc As Variant, myDoc As Document
    Dim myRange As Range
    On Error Resume Next    '忽略错误
    '定义一个文件夹选取对话框
    Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
    With MyDialog
        .Filters.Clear    '清除所有文件筛选器中的项目
        .Filters.Add "所有 WORD 文件", "*.doc", 1    '增加筛选器的项目为所有WORD文件
        .AllowMultiSelect = True    '允许多项选择
        If .Show <> -1 Then Exit Sub
        For Each oDoc In .SelectedItems    '在所有选取项目中循环
            '以藏方式打开Word文档
            Set myDoc = Word.Documents.Open(FileName:=oDoc, Visible:=False)
            Set myRange = myDoc.Paragraphs.First.Range    '取得第1个段落区域
            myRange.SetRange myRange.Start, myRange.End - 1
            myRange.Text = Mid(myDoc.Name, 1, Len(myDoc.Name) - 4)
            myDoc.Close True    '保存并关闭文档
        Next
    End With
End Sub
'----------------------