VBA 单词链接列表模板无法正常工作

Question

我遇到了这个问题，不知道为什么。我有一个创建一些样式的过程，其中一些带有链表模板。我在 normal.dotm 模板（工作内容）中有这个模块。我第一次执行此操作时，它工作正常并创建了所有样式，包括链接到列表样式的样式。但是在那之后，当我打开单词时，链接到列表样式显示为未链接，如果我再次执行该过程，它会创建它们取消链接。知道吗？提前致谢

在这里的代码中，CrearEstilos 首先删除所有快速样式和创建的快速样式，然后重新创建并使其成为快速样式

Dim aux As Integer
Sub CrearEstilos()
 BorrarEstilos
 Estilos
 EstilosRapidos
End Sub

Private Sub Estilos()
'Procedimiento para crear los estilos en caso necesario
    Dim t1 As Style, t2 As Style, t3 As Style, t4 As Style, pregunta As Style, respuesta As Style, recuer As Style, inde As Style
'Titulo nivel 1
If existe("Titulo nivel 1") = False Then
Set t1 = ActiveDocument.Styles.Add(Name:="Titulo nivel 1", _
                                         Type:=WdStyleType.wdStyleTypeParagraph)
With t1
    .Font.Bold = False
    .Font.Italic = False
    .Font.Name = "Verdana"
    .Font.Size = 36
    .ParagraphFormat.OutlineLevel = wdOutlineLevel1
    .ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
    .ParagraphFormat.LineSpacing = LinesToPoints(1)
End With
End If
'Titulo nivel 2
If existe("Titulo nivel 2") = False Then
Set t2 = ActiveDocument.Styles.Add(Name:="Titulo nivel 2", _
                                         Type:=WdStyleType.wdStyleTypeParagraph)
With t2
    .Font.Bold = True
    .Font.Italic = False
    .Font.Name = "Verdana"
    .Font.Size = 16
    .ParagraphFormat.OutlineLevel = wdOutlineLevel2
    .ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
    .ParagraphFormat.LineSpacing = LinesToPoints(1)
End With
End If
'Titulo nivel 3
If existe("Titulo nivel 3") = False Then
Set t3 = ActiveDocument.Styles.Add(Name:="Titulo nivel 3", _
                                         Type:=WdStyleType.wdStyleTypeParagraph)
With t3

    .Font.Bold = True
    .Font.Italic = False
    .Font.Name = "Verdana"
    .Font.Size = 14
    .ParagraphFormat.OutlineLevel = wdOutlineLevel3
    .ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
    .ParagraphFormat.LineSpacing = LinesToPoints(1)
End With
End If
'Titulo nivel 4
If existe("Titulo nivel 4") = False Then
Set t4 = ActiveDocument.Styles.Add(Name:="Titulo nivel 4", _
                                         Type:=WdStyleType.wdStyleTypeParagraph)
With t4
    .Font.Bold = True
    .Font.Italic = False
    .Font.Name = "Verdana"
    .Font.Size = 12
    .ParagraphFormat.OutlineLevel = wdOutlineLevel4
    .ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
    .ParagraphFormat.LineSpacing = LinesToPoints(1)
End With
End If
'Titulo independiente
If existe("Titulo independiente") = False Then
Set t4 = ActiveDocument.Styles.Add(Name:="Titulo independiente", _
                                         Type:=WdStyleType.wdStyleTypeParagraph)
With t4
    .Font.Bold = True
    .Font.Italic = True
    .Font.Name = "Verdana"
    .Font.Size = 11
    .ParagraphFormat.OutlineLevel = 10
    .ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
    .ParagraphFormat.LineSpacing = LinesToPoints(1)
End With
End If
'Preguntas
If existe("Preguntas autoevaluacion") = False Then
Set pregunta = ActiveDocument.Styles.Add(Name:="Preguntas autoevaluacion", _
                                         Type:=WdStyleType.wdStyleTypeParagraph)
With pregunta
    .Font.Bold = True
    .Font.Italic = False
    .Font.Name = "Verdana"
    .Font.Size = 10
    .ParagraphFormat.OutlineLevel = 10
    .ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
    .ParagraphFormat.LineSpacing = LinesToPoints(1)
End With
End If
'Respuestas
If existe("Respuestas autoevaluacion") = False Then
Set respuesta = ActiveDocument.Styles.Add(Name:="Respuestas autoevaluacion", _
                                         Type:=WdStyleType.wdStyleTypeParagraph)

With respuesta
    .Font.Bold = False
    .Font.Italic = False
    .Font.Name = "Verdana"
    .Font.Size = 10
    .ParagraphFormat.OutlineLevel = 10
    .ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
    .ParagraphFormat.LineSpacing = LinesToPoints(1)
    .LinkToListTemplate ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(5), _
                ListLevelNumber:=1
    End With
End If
'Recuerdas
If existe("Recuerdas unidad") = False Then
Set recuer = ActiveDocument.Styles.Add(Name:="Recuerdas unidad", _
                                         Type:=WdStyleType.wdStyleTypeParagraph)

With recuer
    .Font.Bold = False
    .Font.Italic = False
    .Font.Name = "Verdana"
    .Font.Size = 10
    .ParagraphFormat.OutlineLevel = 10
    .ParagraphFormat.LineSpacingRule = wdLineSpaceAtLeast
    .ParagraphFormat.LineSpacing = LinesToPoints(1)
    .LinkToListTemplate ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1), _
                ListLevelNumber:=1
    End With
End If
ActiveDocument.UpdateStyles
End Sub
Private Sub EstilosRapidos()
'Establece los estilos rápidos
Dim s As Style
'Primero borramos la lista
For Each s In ActiveDocument.Styles
    If s.Type = wdStyleTypeCharacter Or _
        s.Type = wdStyleTypeParagraph Or _
        s.Type = wdStyleTypeLinked Then
        s.QuickStyle = False
    End If
Next s
'Creamos los estilos
'Estilos
'Marcamos como rápidos los necesarios
For Each s In ActiveDocument.Styles
    If s.NameLocal = "Titulo nivel 1" Or s.NameLocal = "Titulo nivel 2" Or s.NameLocal = "Titulo nivel 3" Or _
    s.NameLocal = "Titulo nivel 4" Or s.NameLocal = "Preguntas autoevaluacion" Or s.NameLocal = "Respuestas autoevaluacion" Or _
    s.NameLocal = "Recuerdas unidad" Or s.NameLocal = "Normal" Or s.NameLocal = "Titulo independiente" Then
        s.QuickStyle = True
    End If
Next s
End Sub
Private Sub BorrarEstilos()
'Establece los estilos rápidos
Dim r As Style
'Primero borramos la lista
For Each r In ActiveDocument.Styles
    If r.Type = wdStyleTypeCharacter Or _
        r.Type = wdStyleTypeParagraph Or _
        r.Type = wdStyleTypeLinked Then
        r.QuickStyle = False
    End If
Next r
Dim s As Style
'Primero borramos la lista
For Each s In ActiveDocument.Styles
    If s.NameLocal = "Recuerdas" Or s.NameLocal = "Respuestas" Or s.NameLocal = "Respuesta" _
    Or s.NameLocal = "Recuerda" Or s.NameLocal = "Variado" Or s.NameLocal = "probando" Or _
    s.NameLocal = "Titulo nivel 1" Or s.NameLocal = "Titulo nivel 2" Or s.NameLocal = "Titulo nivel 3" Or _
    s.NameLocal = "Titulo nivel 4" Or s.NameLocal = "Titulo independiente" Or s.NameLocal = "Preguntas" Then
        s.Delete
    End If
Next s
End Sub

Answer 1

嗯，

我是这里的菜鸟，但是，虽然我不明白为什么，如果你评论这条线......

ActiveDocument.UpdateStyles

。你的代码对我来说很好用