Ruban Perso XML / Macro VBA

**jokobugs** · 11/12/2014, 16h59

Bonjour à tous,

Le vous présente mon problème que je n'arrive pas à résoudre :

j'ai créer mon ruban personnalisé avec Custom UI Editor, en raccordant à mes macros existante, je rajoute dans les parenthèse ex: Sub ins_ttx(control As IRibbonControl)

Dans cette macro, je fais appel à une autre pour lancé une exécution particulière, qui elle aussi est raccordé au ruban de la même manière ex : ins_ligne(control As IRibbonControl)

et à ce moment BUG. je suppose une erreur d'écriture, évidement sinon ça ne boguerai pas :lol:

pour être claire voici mon texte de Custom :

Code xml :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
      <button id="BT17" 
	label="Total Chapitre" 
	screentip="Insère le total du chapitre renseigné."
      onAction="ins_ttx" 
	size="normal" 
	imageMso="TableStyleTotalsRow" />

voici celui de ma macro N°1 :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub ins_ttx(control As IRibbonControl)
    Dim placeresult As String
    Dim numchap As String
    Dim i As Integer
    Dim j As Integer
    Dim deb As Integer
    Dim sum As Double
    Dim sum2 As Double
 
    If ActiveSheet.Name = "Etude" Or ActiveSheet.Name = "Etude opt" Then
        ActiveSheet.Unprotect
        Application.ScreenUpdating = False
        numchap = InputBox("numero du chapitre")
        sum = 0
        sum2 = 0
        i = 8
        j = 0
        If numchap <> "" Then
            ' Boucle pour trouver le chapitre de départ, si il n'existe pas le curseur s'arrete au mot fin
            ' situer à la dernière ligne du fichier
            Do While (Range("B" & i) <> numchap) Or (Range("B" & i).Font.Bold = False) And (Range("B" & i) <> "Fin")
                i = i + 1
            Loop
 
            If Range("B" & i) <> "Fin" Then
                i = i + 1
                deb = i
                ' Recherche du chapitre suivant
                Do While ((Range("B" & i).Font.Bold = False) Or (Range("B" & i).Font.ColorIndex <> 1)) And ((Range("B" & i).Font.Bold = False) Or (Range("B" & i).Font.ColorIndex <> 2))
                    i = i + 1
                Loop
 
                ' On insert 6 ligne pour pouvoir afficher la somme
                Do While j < 7
                    Rows(i - 1 + j & ":" & i - 1 + j).Select
                    Run "ins_ligne"
                    j = j + 1
                Loop
 
                ' Première ligne contient le total HT c'est à dire la somme de la colone K et la somme de la colone P
                ActiveSheet.Unprotect
                Range("d" & i + j - 6).Value = "TOTAL HT:"
                Range("d" & i + j - 6).Font.Bold = True
                Range("d" & i + j - 6).IndentLevel = 10
                Range("J" & i + j - 6).Formula = "=SUM(K" & deb & ":K" & i & ")"
                Range("O" & i + j - 6).Formula = "=SUM(P" & deb & ":P" & i & ")"
                Range("J" & i + j - 6).Font.Bold = True
                Range("O" & i + j - 6).Font.Bold = True
 
                ' La deuxième ligne contient la part de TVA à rajouter
                Range("d" & i + j - 5).Formula = "= ""TVA à "" & Dépenses!tva*100 & "" % :"" "
                Range("d" & i + j - 5).IndentLevel = 10
                Range("J" & i + j - 5).Formula = "=SUM(K" & deb & ":K" & i & ")* Dépenses!tva"
                Range("O" & i + j - 5).Formula = "=SUM(P" & deb & ":P" & i & ")* Dépenses!tva"
 
                ' La troisième la somme avec la TVA
                Range("d" & i + j - 4).Value = "TOTAL TTC:"
                Range("d" & i + j - 4).Font.Bold = True
                Range("d" & i + j - 4).IndentLevel = 10
                Range("J" & i + j - 4).Formula = "=SUM(K" & deb & ":K" & i & ")* ( 1 + Dépenses!tva)"
                Range("O" & i + j - 4).Formula = "=SUM(P" & deb & ":P" & i & ")* ( 1 + Dépenses!tva)"
                Range("J" & i + j - 4).Font.Bold = True
                Range("O" & i + j - 4).Font.Bold = True
            Else:
                MsgBox " le chapitre " & numchap & " n'existe pas"
            End If
        End If
 
        Application.ScreenUpdating = True
        ActiveSheet.Protect , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    Else:
        MsgBox " Vous devez être sur une page d'etude "
    End If
 
End Sub

et voici celui à laquelle cette macro fait appel :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Sub ins_ligne(control As IRibbonControl)
    ' Cette macro insere une ligne et duplique les formules nécessaires
    ' c'est à dire les formules des colones J à P, AD
    ' Nous avons procéder de cette manière car il n'existe pas à notre connaissance
    ' d'option permettant de recopier exclusivement les formules sans les données
    Dim i As String
 
    ActiveSheet.Unprotect
    Application.ScreenUpdating = False
    Rows(Selection.Row).Select
    Selection.EntireRow.Insert
    i = Selection.Row - 1
    Range("J" & i & ":P" & i).AutoFill Destination:=Range("J" & i & ":P" & i + 1), Type:=xlFillDefault
    Range("Y" & i & ":AD" & i).AutoFill Destination:=Range("Y" & i & ":AD" & i + 1), Type:=xlFillDefault
 
    ' Lorsque l'on insere sous un chapitre la ligne insere prend le format de celui ci
    ' donc il faut remettre au bon format
    If (Range("B" & i).Font.Bold = True) Then
        With Range("B" & i + 1 & ":F" & i + 1)
            With .Font
                .FontStyle = "Normal"
                .ColorIndex = 5
            End With
            With .Borders(xlEdgeLeft)
                 .LineStyle = xlContinuous
                 .Weight = xlHairline
                 .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeRight)
                 .LineStyle = xlContinuous
                 .Weight = xlHairline
                 .ColorIndex = xlAutomatic
            End With
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Interior.ColorIndex = xlNone
            .ClearContents
        End With
 
        With Range("B" & i + 1)
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlHairline
                .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlHairline
                .ColorIndex = xlAutomatic
            End With
        End With
 
        With Range("G" & i + 1 & ":P" & i + 1)
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Interior.ColorIndex = xlNone
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlHairline
                .ColorIndex = xlAutomatic
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlHairline
                .ColorIndex = xlAutomatic
            End With
        End With
    End If
 
    Range("B" & i + 1).Select
    Application.ScreenUpdating = True
 
    ' Lorsque l'on insere sur un chapitre la ligne insere prend également une partie du
    ' format de celui ci
    ' donc il faut remettre au bon format
 
    '   Selection.AutoFill Destination:=Rows(i & ":" & i + 1), Type:=xlFillDefault
    '   Range("A" & i + 1).Value = ""
    ActiveSheet.Protect , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
 
End Sub

PS : La second macro marche très bien indépendamment des autres.

Merci par avance pour vos réponse, votre temps passé sur le sujet, et votre aide. ;)

**XLRATOR** · 11/12/2014, 19h01

Bonjour,

et à ce moment BUG

Quel genre de bug s'agit-il? autrement dit quel message d'erreur ça renvoie?

Merci.
Karim.

**jokobugs** · 11/12/2014, 19h10

Bonjour,

il me dit argument non facultatif!!!

Merci

**XLRATOR** · 11/12/2014, 21h16

Alors ça confirme ce que je pensais,
En effet les deux procédures toute une chacune s'attendent à ce qu'on clique sur leurs boutons respectifs et ce suite à l'argument:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

(control As IRibbonControl)

.
Alors dans ce cas La première s'exécuterait parce que le bouton qui lui revient aurait été cliqué (Si l'instruction qui lui revient vient en premier biensûr), mais l'autre dont le bouton n'aurait pas été cliqué vous planterait le reste.
Je vous suggère de mettre les procédures dans un module puis y faire appel dans l'Evénément clique de vos boutons rubans.

Cordialement.
Karim.

**jokobugs** · 12/12/2014, 12h33

Bonjour,

Merci Karim, effectivement je pense aussi que cela doit marché,
mais j'aurais voulus connaitre si il existe une syntaxe permettant d'évité d'en passé par la.

merci par avance à tous ceux qui aurais la solution de nous la communiqué.

Pour info Karim ta solution marche sauf que j'ai tjrs 4 macros réticente, pourtant la syntaxe est identique.

le code du boutton :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
'Callback for BT04 onAction
Sub saisie(control As IRibbonControl)
mode_saisie_2
End Sub

et celui de la macro appelée :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub mode_saisie_2()
    ' Saisie_etude Macro
    ' Macro enregistrée le 14/06/99 par DV
    Dim monObjet As Range
 
    If ActiveSheet.Name <> "Etude" And ActiveSheet.Name <> "Etude opt" Then
        MsgBox ("Feuille non valide pour cette opération")
    Else:
        fin_saisie_2
        ActiveSheet.Unprotect
        Set monObjet = ActiveCell
        Columns("M:R").EntireColumn.Hidden = True
        Rows("1:3").EntireRow.Hidden = True
        Columns("A:A").EntireColumn.Hidden = True
        Columns("X:AD").EntireColumn.Hidden = True
        Range("A1").Select
        Range("J7").Select
        ActiveWindow.FreezePanes = True
        monObjet.Select
        ActiveSheet.Protect , AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True
    End If
 
End Sub

et lors du clic sur le bouton le message d'erreur qui apparait est :
"impossible d'exécuter la macro 'saisie'. Il est possible qu'elle ne soit pas disponible dans ce classeur ou que les macros son désactivées"

je sèche grave j'ai essayé tous les mode d'appel, et je ne sais plus quoi faire....

Application.Run ("nom_macro")
Run "nom_macro"
Call "nom_macro"
nom_macro

rien à faire, si qqun à une solution. Merci

**XLRATOR** · 12/12/2014, 15h17

Bonjour jokobugs,
Je pense que ce que je vous ai proposé dans mon dernier message marcherait trés bien:

Je vous suggère de mettre les procédures dans un module puis y faire appel dans l'Evénément clique de vos boutons rubans.

Procédez comme suit:

Le code de votre bouton ruban:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Sub saisie(control As IRibbonControl)
Procédure1
Procédure2
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub Procédure1()
Bla Bla Bla
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub Procédure2()
Bla Bla Bla
End Sub

Comme ça vous aurait fait appel au deux procédures, séparément et sans problèmes.
Bon courage.
Karim.

**jokobugs** · 16/12/2014, 11h10

Merci Karim,

C'est ce que j'avais déjà fait mais en faut le bug ce créait car j'avais des noms de macro trop long ou étant similaire à une commande.

Voilà donc pb résolu.

Merci.

Ruban Perso XML / Macro VBA [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager