如何插入word标题

tan1365999076 · 发表于 2019-1-24 16:42

我从网上下载了许多WORD文件，但可惜只有文件名，打开文件后，每个WORD都没有标题，哪位高手请帮我用文件名作标题插入到WORD文件中

zmj9151 · 发表于 2019-1-24 17:07

需要vba编程，请上附件

tan1365999076 · 发表于 2019-2-3 12:44

自己顶一下，请大师帮帮忙

tan1365999076 · 发表于 2019-5-30 16:36

自己顶一下，各位大咖帮一帮忙！！！

tan1365999076 · 发表于 2019-5-30 16:37

zmj9151 发表于 2019-1-24 17:07
需要vba编程，请上附件

请帮忙！！！

413191246se · 发表于 2019-5-30 23:47

都快 4 个月了，楼主仍然想求解，好有耐心。

tan1365999076 · 发表于 2019-5-31 09:44

自己顶一下，各位大咖帮一帮忙！！！

413191246se · 发表于 2019-5-31 15:12

楼主，下面有 3 个小宏，是一体的，请备份原文件后应用（双击进入欲处理的文件夹，按确定），执行下面 3 个宏中的 test 宏即可：

Sub test()
On Error Resume Next
Dim fd As FileDialog, p$, doc As Document, n&, g&
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
If fd.Show = -1 Then p = fd.SelectedItems(1) Else End
Set fd = Nothing
If MsgBox("是否处理文件夹 " & p & " ?", 4 + 48) = vbNo Then End
Dim FileNameWithPath As Variant, ListOfFilenamesWithParh As New Collection
Call FileSearchByHavrda(ListOfFilenamesWithParh, p, "*.docx", True)
For Each FileNameWithPath In ListOfFilenamesWithParh
Set doc = Documents.Open(FileName:=FileNameWithPath)
With doc
SingleDoc
.Close savechanges:=wdSaveChanges
End With
n = n + 1
Next FileNameWithPath
If ListOfFilenamesWithParh.Count = 0 Then MsgBox "File not found!"
MsgBox "处理完毕！共处理 " & n & " 个文档！", 0 + 48
End Sub
Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)
Dim DirFile As String, CollectionItem As Variant, SubDirCollection As New Collection
pPath = Trim(pPath)
If Right(pPath, 1) <> "" Then pPath = pPath & ""
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile
DirFile = Dir
Loop
If Not pIncludeSubdirectories Then Exit Sub
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile
DirFile = Dir
Loop
For Each CollectionItem In SubDirCollection
Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories)
Next
End Sub
Sub SingleDoc()
Dim t As Table
With ActiveDocument
.Content.Find.Execute "[^13^11]", , , 1, , , , , , "^p", 2
If .Tables.Count = 0 Then
With .Content
.InsertBefore Text:=Left(.Parent.Name, Len(.Parent.Name) - 5) & vbCr
.Font.Size = 16
With .ParagraphFormat
.CharacterUnitFirstLineIndent = 2
.Space15
End With
End With
Else
For Each t In .Tables
With t.Range.Rows
.WrapAroundText = False
.Alignment = wdAlignRowCenter
End With
Next
If .Paragraphs(1).Range.Information(12) Then
.Paragraphs(1).Range.Select
Selection.SplitTable
Selection.TypeText Text:=Left(.Name, Len(.Name) - 5)
Else
.Content.InsertBefore Text:=Left(.Name, Len(.Name) - 5) & vbCr
End If
End If
With .Paragraphs(1).Range
.Style = wdStyleHeading1
With .ParagraphFormat
.SpaceBefore = 24
.SpaceAfter = 24
.Space15
.Alignment = wdAlignParagraphCenter
End With
With .Font
.Size = 26
.Color = wdColorAutomatic
End With
End With
End With
Selection.HomeKey Unit:=wdStory
End Sub

复制代码

ccdi · 发表于 2019-5-31 17:39

帮顶一下（顺便也为了积分）

tan1365999076 · 发表于 2019-6-3 08:55

还是不行呢，总是出现“File not found!”，我还想不一定是docx文件，还可能是doc文件

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

[求助] 如何插入word标题