Complément de mise en page erreur 9

Le 17/05/2020 à 12:06

Bonjour à tous,

J'espère que vous allez bien.

Suite à une mise à jour, désormais je suis sous O365 32bits et beaucoup de mes compléments et macros plantent, j'arrive à en dégueuger certains mais pas tous.

Etant un analyste financier, je peux perdre beaucoup de temps afin que tout un document soit dans la même mise en page pour que ce soit consistant. Mais si jamais mon client veut finalement changer en dernière minute le bleu pour du violet afin d'éviter de modifier manuellement tout le modèle je passe par un complément de gestion de styles.

Le complément (normalement en xlam) fonctionnait très bien jusqu'à la mise à jour. Pour que ce soit plus simple, le voici en .xlsm.

Le fonctionnement est simple:

> une feuille de style ("Formats_1"): sur laquelle on peut mettre ce que l'on veut comme styles, il n'y en a que 8 mais avant pour en ajouter davantage il suffit de créer un style en suivant la nomenclature

> un raccourci Ctrl + Shift + A : qui ouvre l'userform (StyleForm) qui va récupérer les styles dans la feuille style (tout la mise en page etc) et qui lorsque que l'on sélectionne un style l'applique (touche entrée) sur la/les cellule(s) sélectionnées. A partir de cet usf on peut également modifier les styles (peu utile en .xlsm mais en .xlam, en gros ca sortait du mode complément pour permettre de modifier ce que l'on voulait, en cliquant sur sauvegarder ca rebasculait en .xlam) ; j'ai mis en commentaires les codes qui forçait à l'ouverture à la modification et a la fermeture du complément le fait de repasser en .xlam.

Désormais, je ne sais plus pourquoi, dès que je lance l'userform (Ctrl + Shift + A) j'obtiens une erreur 9 ! Sur mon autre PC encore sous Office 2016 aucun problème pourtant.

Voici le document en pièce jointe, si une bonne âme peut aider.

2styler.xlsm (33.13 Ko)

Aussi pour ceux qui ne veulent pas télécharger le fichier, voici le code:

Pour l'ouverture de l'usf (s'active par Ctrl + Shift + A)

Sub OuvrirStyleFrm()
Dim ws As Workbook
Dim c As Control
Dim sname As String
Set ws = Application.Workbooks("Styler.xlsm")
ws.Activate
    For Each c In StylesForm.Controls
        If InStr(c.Name, "Style_") = 0 Then
        Else
        sname = ws.Sheets("Formats_1").Range(c.Name).Value
            With c
                .Caption = ActiveWorkbook.Styles(sname).Name
                .ForeColor = ActiveWorkbook.Styles(sname).Font.Color
                .BackColor = ActiveWorkbook.Styles(sname).Interior.Color
                .Font.Bold = ActiveWorkbook.Styles(sname).Font.Bold
                .Font.Italic = ActiveWorkbook.Styles(sname).Font.Italic
                .Font.Size = ActiveWorkbook.Styles(sname).Font.Size
                .Font.Name = ActiveWorkbook.Styles(sname).Font.Name
            End With
        End If
    Next c
StylesForm.Show (vbModeless)
End Sub

Code d'application du style: 

Sub AppliquerStyle()
Dim stylename As String, c As Range
Dim ws As Workbook
Set ws = Application.Workbooks("Styler.xlsm")
    For Each c In ws.Sheets("Formats_1").Range("List_Styles")
        If c.Value = "" Then
            Else
                With ActiveWorkbook.Styles(c.Text)
                    .IncludeAlignment = False
                    .IncludeBorder = True
                    .IncludeFont = True
                    .IncludeNumber = False
                    .IncludePatterns = True
                    .IncludeProtection = True
                End With
                With ActiveWorkbook.Styles(c.Text)
                    .Font.Name = c.Font.Name
                    .Font.Size = c.Font.Size
                    .Font.Color = c.Font.Color
                    .Font.Bold = c.Font.Bold
                    .Interior.Color = c.Interior.Color
                    .Interior.Pattern = c.Interior.Pattern
                    .Locked = c.Locked
                End With

                With ActiveWorkbook.Styles(c.Text)
                    For i = 1 To 8
                        .Borders(i).LineStyle = xlNone
                    Next i
                    For i = 1 To 8
                        .Borders(i).Color = c.Borders(i).Color
                        .Borders(i).Weight = c.Borders(i).Weight
                        .Borders(i).LineStyle = c.Borders(i).LineStyle
                    Next i
                End With
        End If
    Next c
End Sub

Code de l'usf:

Private Sub AppliStyles_Click()
    AppliquerStyle
    OuvrirStyleFrm
End Sub
Private Sub Annuler_Click()
    Unload Me
End Sub
Private Sub ModStyles_Click()
'On Error Resume Next
'    Application.Workbooks("Styler.xlam").IsAddin = False
'    Windows("Styler.xlam").Activate
'    Unload Me
End Sub
Private Sub Style_1_Click()
    Selection.Style = ActiveControl.Caption
    Unload Me
End Sub
Private Sub Style_2_Click()
    Selection.Style = ActiveControl.Caption
    Unload Me
End Sub
Private Sub Style_3_Click()
    Selection.Style = ActiveControl.Caption
    Unload Me
End Sub
Private Sub Style_4_Click()
    Selection.Style = ActiveControl.Caption
    Unload Me
End Sub
Private Sub Style_5_Click()
    Selection.Style = ActiveControl.Caption
    Unload Me
End Sub
Private Sub Style_6_Click()
    Selection.Style = ActiveControl.Caption
    Unload Me
End Sub
Private Sub Style_7_Click()
    Selection.Style = ActiveControl.Caption
    Unload Me
End Sub
Private Sub Style_8_Click()
    Selection.Style = ActiveControl.Caption
    Unload Me
End Sub
Private Sub UserForm_Click()
End Sub

Merci à tous pour votre aide,

Naxos

Le 17/05/2020 à 13:53

Bonjour,

Avant la mise à jour, quelle était la version de Excel ?

ric

Le 17/05/2020 à 15:41

Bonjour,

Dans le fichier soumis, le style "Texte Explicatif" existe. Mais, il semble que l'espace entre les expressions semble poser problème.

De plus "Titre 1", "Titre 2", "Titre 3" semblent entrer en conflit avec les styles existants.

Modifier B8, B12, B14, B16 pour ajouter des soulignés entre les expressions.

Ajouter un teste si le style n'existe pas ...

Un essai ...

Sub OuvrirStyleFrm()
Dim ws As Workbook
Dim c As Control
Dim Sname As String
Set ws = Application.Workbooks("Styler.xlsm")
ws.Activate

    For Each c In StylesForm.Controls
        If InStr(c.Name, "Style_") = 0 Then
        Else
        Sname = ws.Sheets("Formats_1").Range(c.Name).Value

        '' Teste si le style existe...
        If Not StyleExists(Sname, ActiveWorkbook) Then ActiveWorkbook.Styles.Add Name:=Sname

            With c
                .Caption = ActiveWorkbook.Styles(Sname).Name
                .ForeColor = ActiveWorkbook.Styles(Sname).Font.Color
                .BackColor = ActiveWorkbook.Styles(Sname).Interior.Color
                .Font.Bold = ActiveWorkbook.Styles(Sname).Font.Bold
                .Font.Italic = ActiveWorkbook.Styles(Sname).Font.Italic
                .Font.Size = ActiveWorkbook.Styles(Sname).Font.Size
                .Font.Name = ActiveWorkbook.Styles(Sname).Font.Name
            End With
        End If
    Next c
StylesForm.Show (vbModeless)
End Sub

    '' Teste si le style existe
Public Function StyleExists(ByVal styleName As String, ByVal target As Workbook) As Boolean
' Returns TRUE if the named style exists in the target workbook.
    On Error Resume Next
    StyleExists = Len(target.Styles(styleName).Name) > 0
    On Error GoTo 0
End Function

Je te laisse faire d'autres tests pour adapter à ton besoin ...

1styler.xlsm (34.57 Ko)

ric

Le 17/05/2020 à 18:24

Bonsoir Ric,

Merci pour ton retour, brillant !

Je n'avais pas pensé aux conflits entre styles et aux noms donnés, étant donné qu'ils étaient encadrés par ailleurs par un nom de cellule => A croire que je dois revoir cette partie aussi

Pour répondre, effectivement mon Excel était en anglais avant la migration . . . . . Et effectivement avant un style "Bonjour Forum" après la migration s'appelle "Bonjour_Forum"

De mon côté tout fonctionne de nouveau grâce à ta solution, comme je te disais la gestion des noms est à revoir de mon côté pour éviter un conflit futur mais pour l'instant ca refonctionne!

Merci et très bonne fin de journée,

Naxos

Rechercher des sujets similaires à "complement mise page erreur"