Ruban Perso XML / Macro VBA

Version imprimable

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:

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:

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:

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. ;)

11/12/2014, 18h01
XLRATOR

Bonjour,

Citation:

et à ce moment BUG

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

Merci.
Karim.
11/12/2014, 18h10
jokobugs

Bonjour,

il me dit argument non facultatif!!!

Merci
11/12/2014, 20h16
XLRATOR

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:

(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.

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é.:D

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:

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:

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

12/12/2014, 14h17
XLRATOR
Bonjour jokobugs,
Je pense que ce que je vous ai proposé dans mon dernier message marcherait trés bien:

Citation:

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:

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

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

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.
16/12/2014, 10h10
jokobugs

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.