Vba 使用Microsoft Word导入样式

我有一个宏，它运行在给定文件夹中的所有文件上。My

Normal.dotm

全局模板具有宏使用的3种字体样式，但是宏停止，因为它反复找不到宏调用的样式。最简单的方法是创建一个宏（或添加到我的当前文档），该宏将自动将这3种样式从全局模板导入活动文档

以下是我目前掌握的情况：

Application.OrganizerCopy Source:= _
    "C:\Users\Inu\AppData\Roaming\Microsoft\Templates\Normal.dotm", _
    Destination:= _
    ActiveDocument _
    , Name:="DO_NOT_TRANSLATE", Object:=wdOrganizerObjectStyles
Application.OrganizerCopy Source:= _
    "C:\Users\Inu\AppData\Roaming\Microsoft\Templates\Normal.dotm", _
    Destination:= _
    ActiveDocument _
    , Name:="tw4winExternal", Object:=wdOrganizerObjectStyles
Application.OrganizerCopy Source:= _
    "C:\Users\Inu\AppData\Roaming\Microsoft\Templates\Normal.dotm", _
    Destination:= _
    ActiveDocument _
    , Name:="tw4winInternal", Object:=wdOrganizerObjectStyles

---

有什么帮助吗？我有大约一百个需要格式化的文件，因此单独导入是不可能的。

如果您准备了一个具有所需样式的模板，您可以使用以下命令将其全部复制：

ActiveDocument.CopyStylesFromTemplate("C:\Temp\FullPathToTemplate.dotx")

---

或者您已经用另一种方法解决了吗？

原始代码的问题是

应用程序中的Destination参数。OrganizerCopy

需要是字符串-目标文档的完整路径。我已经测试了以下代码，发现它可以工作（Word 2013）：

Sub-test\u-style\u-copy（）
Dim B_作为布尔值失败
从正常调用添加样式（ActiveDocument，“Orcamento”，B_失败）
端接头
' -------------------------------------------------------------------------------------
从\u普通添加\u样式\u（目标\u文档为Word.document_
样式_名称为字符串，B_失败为布尔值）
'将样式“style_name”从普通模板添加到可用样式
"在文件中,
Dim B_法线为布尔值
变暗复制样式作为变体
作为Word.Document的Dim normal_模板
B_fail=False
'测试中是否已存在样式“style_name”
如果存在样式（目标文档、样式名称），则退出Sub
'将普通模板作为文档打开，并测试样式“style_name”是否正确
'在正常模板中存在
设置normal\u template=Application.NormalTemplate.OpenAsDocument
B_Normal=存在样式（普通模板、样式名称）
正常模板关闭
设置普通模板=无
“Style”Style_name“不在正常模板中，退出：
如果不是正常的话
MsgBox“无法将样式”“和样式名称&”“从Normal.dotm复制到”&”_
vbCr&destination_document.Name&“：”&vbCr&vbCr&_
“Style”“”和Style_name&“在Normal.dotm中不存在”，vbCritical
B_fail=True
出口接头
如果结束
将样式“样式名称”从普通模板复制到
应用
.OrganizerCopy源：=.NormalTemplate.FullName_
目的地：=目的地_document.FullName_
名称：=样式\名称，对象：=wdOrganizerObjectStyles
以
'检查样式是否已成功复制：
B_fail=不存在样式（目标文档、样式名称）
如果B_失败，则MsgBox“样式副本”&样式名称&“收件人”&_
目标\ u document.Name&“失败”，vbCritical
端接头
' -------------------------------------------------------------------------------------
函数样式_以布尔形式存在（test_文档为Word.document，样式_名称为String）
'style\u exists=TRUE样式文档中存在“style\u name”
'=假缺席
style_exists=False
出错时继续下一步
style\u exists=test\u document.style（style\u name）.NameLocal=style\u name
端函数

我不知道您是否对上述解决方案感到满意，但由于问题仍然被列为“未回答”，因此我使用的代码（稍微简化）正好用于解决此问题：

Sub Test()
    Const C_St1 = "style-1"
    Const C_St2 = "style-2"
    Const C_St3 = "style-3"

    A_Styles = Array(C_St1, C_St2, C_St3)
    Call VerifyExistenceOfStyles(A_Styles, V_Errors)
    Debug.Print V_Errors
End Sub

Sub VerifyExistenceOfStyles(A_Styles, Optional V_Errors)
    On Error Resume Next
    For Each V_Style In A_Styles
        If V_Style = "" Then
            'do nothing
        Else
            Err.Clear
            tmp = ActiveDocument.Styles(V_Style).Font.Size 'checking whether style exists
            V_ErrNumber = Err.Number
            If V_ErrNumber = 5941 Then Call AddMissingStyleFromTemplate(V_Style, V_Error) Else V_Error = ""
        End If
        V_Errors = V_Errors & IIf(V_Error = "", "", V_Error & vbCr)
    Next
    On Error GoTo 0
End Sub

Sub AddMissingStyleFromTemplate(V_Style, Optional V_Error)
    V_Template = ActiveDocument.AttachedTemplate.Path & Application.PathSeparator & ActiveDocument.AttachedTemplate.Name
    V_File = ActiveDocument.FullName

    On Error Resume Next
    Application.OrganizerCopy _
      Source:=V_Template, _
      Destination:=V_File, _
      Name:=V_Style, _
      Object:=wdOrganizerObjectStyles
    If Err.Number = 0 Then  'no error, style found in template
        V_Error = ""
    ElseIf Err.Number = 5608 Then 'is no style name
        V_Error = "|" & V_Style & "| is no valid style name, neither in the document nor in the template!"
    Else
        V_Error = "|" & V_Style & "| produces the unidentified error " & Err.Number
    End If
End Sub

---

为什么不将样式从

Normal.dotm

复制到您的文件中呢

过程如下：

打开样式窗口9Alt+Ctrl+Shift+S）

选择“管理样式”（在窗口底部，左侧第三个图标）

选择导入/导出

在窗口左侧加载

Normal.dotm

在窗口右侧加载

SomeDoc.dotm

从左侧窗口（在

Normal.dotm

中）选择要复制的

样式

选择复制

这些

样式

现在已导入到您的文档中。确保将文档另存为启用宏的模板

.dotm

在这之后，这不应该成为一个问题

Sub Test()
    Const C_St1 = "style-1"
    Const C_St2 = "style-2"
    Const C_St3 = "style-3"

    A_Styles = Array(C_St1, C_St2, C_St3)
    Call VerifyExistenceOfStyles(A_Styles, V_Errors)
    Debug.Print V_Errors
End Sub

Sub VerifyExistenceOfStyles(A_Styles, Optional V_Errors)
    On Error Resume Next
    For Each V_Style In A_Styles
        If V_Style = "" Then
            'do nothing
        Else
            Err.Clear
            tmp = ActiveDocument.Styles(V_Style).Font.Size 'checking whether style exists
            V_ErrNumber = Err.Number
            If V_ErrNumber = 5941 Then Call AddMissingStyleFromTemplate(V_Style, V_Error) Else V_Error = ""
        End If
        V_Errors = V_Errors & IIf(V_Error = "", "", V_Error & vbCr)
    Next
    On Error GoTo 0
End Sub

Sub AddMissingStyleFromTemplate(V_Style, Optional V_Error)
    V_Template = ActiveDocument.AttachedTemplate.Path & Application.PathSeparator & ActiveDocument.AttachedTemplate.Name
    V_File = ActiveDocument.FullName

    On Error Resume Next
    Application.OrganizerCopy _
      Source:=V_Template, _
      Destination:=V_File, _
      Name:=V_Style, _
      Object:=wdOrganizerObjectStyles
    If Err.Number = 0 Then  'no error, style found in template
        V_Error = ""
    ElseIf Err.Number = 5608 Then 'is no style name
        V_Error = "|" & V_Style & "| is no valid style name, neither in the document nor in the template!"
    Else
        V_Error = "|" & V_Style & "| produces the unidentified error " & Err.Number
    End If
End Sub