vba word linktolisttemplate不能正常工作

时间:2015-04-21 14:28:20

标签: list vba templates ms-word styles

我遇到了麻烦,不知道为什么。我有一个程序来创建一些样式,其中一些具有链表模板。我在normal.dotm模板(job stuff)中有这个模块。我第一次执行它时它工作正常并创建了所有样式,包括链接到列表样式。但在那之后,当我打开单词时,链接到列表样式会显示为未链接,如果我再次执行该过程,则会创建它们取消链接。任何的想法?提前致谢

这里的代码,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

1 个答案:

答案 0 :(得分:0)

嗯,我是这里的新秀,但是,虽然我不明白为什么,但如果你评论这条线...

ActiveDocument.UpdateStyles

...你的代码对我来说没问题