Regrouper 2 macros en 1 seule

Le 15/10/2011 à 17:16

Bonjour le forum,

J'aimerais si c'est possible réunir ces deux macros en une seule : le 1er clic pour mettre Congés et le 2ème clic pour remettre la mise en forme, les deux codes (codes réalisés avec l'enregistreur) ci-dessous :

Sub Conges()
     Range("B10:G10").Select
    Application.DisplayAlerts = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Selection.ClearContents
    ActiveCell.FormulaR1C1 = "C o n g é s"
        With ActiveCell.Characters(Start:=1, Length:=11).Font
        .Name = "Arial"
        .FontStyle = "Gras"
        .Size = 48
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Application.DisplayAlerts = True
        Range("B10").Select
End Sub
Sub Reinitialiser()
Range("B10:G10").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.ColumnWidth = 16.67
    Selection.Font.Bold = True
    Selection.ClearContents
        Range("B10").Select
    End Sub

Je vous joins un fichier pour que celà soit plus explicite.

D'avance merci pour votre aide

48conges-et-reinitialiser.zip (15.09 Ko)
Le 15/10/2011 à 17:53

Bonjour

Un essai

82libellule85-conges-et-reinitialiser-v001.zip (19.10 Ko)
Le 15/10/2011 à 18:00

Bonsoir,

A mon avis, il faut remplacer tes deux boutons par un seul, mais de type "ToggleButton" (bouton qui peut rester enfoncé) donc le clic appelle successivement les deux macros. Cela ne me semble pas utile de n'avoir qu'une seule macro, mais c'est possible, il suffit de remplacer le call de la macro par son contenu

Voici un exemple de ce que tu peux faire avec un contrôle de type ToggleButton :

Private Sub ToggleButton1_Click()

Application.ScreenUpdating = False ' Permet de figer l'écran et du même coup accélère l'exécution du code

If ToggleButton1.Value = True Then

Call Conges

ToggleButton1.Caption = "Réinialiser" ' Facultatif

Else

Call Reinitialiser

ToggleButton1.Caption = "Congés" ' Facultatif

End If

Application.ScreenUpdating = True

End Sub

A+

Benead

Le 15/10/2011 à 18:12

Bonjour Libellule 85 le forum

tu as décidé de regrouper toutes tes macros !!!!!!!!!!!!!!!!!!!!

a+

Papou

Le 15/10/2011 à 18:28

Bonjour Benead, re Paritec,

@ Benead : merci pour ta réponse, mais comment lancer cette macro à partir du Ruban ?

@ Paritec : En quelque sorte, car ces macros sont lancées à partir d'un ruban personnalisé, c'est donc pour gagner de la place que j'essaye de regrouper mes macros, car tu comprendras j'en suis sûr qu'avoir 4 boutons au lieu de 8 c'est quand même mieux ! non ? Celles-ci se sont les deux dernières !

Le 16/10/2011 à 01:52

Bonsoir,

Tout d'abord il faut créer la barre d'outil avec un bouton :

' Création de la barre d'outils congés
Sub CreationBOCongés()
    Dim CB As CommandBar, CT As CommandBarButton
    On Error Resume Next
    CommandBars("Barre Conges").Delete
    On Error GoTo 0
    Set CB = Application.CommandBars.Add("Barre Conges")
    Set CT = CB.Controls.Add(msoControlButton)
    With CT
        .Caption = "Conges"
        .FaceId = 500 ' Un bouton au hasard
        .OnAction = "PgmConge"
        .TooltipText = "Formatage congés"
    End With
    CB.Visible = True
End Sub

Idéalement, il faut mettre ce code dans l'évènement WorkBook_Open

et supprimer la barre d'outil dans le WorkBook_Close. De cette façon la barre d'outils n'est utilisable qu'avec le classeur de congés.

Ensuite il faut mettre dans un module du classeur cette macro qui appelle tes deux procédures :

 Sub PgmConge()
Application.ScreenUpdating = False ' Permet de figer l'écran et du même coup accélère l'exécution du code
If CommandBars.ActionControl.State = msoButtonUp Then
Call Conges
CommandBars.ActionControl.Caption = "Réinialiser" ' Facultatif
CommandBars.ActionControl.State = msoButtonDown ' bouton pressé
Else
Call Reinitialiser

CommandBars.ActionControl.Caption = "Congés" ' Facultatif
CommandBars.ActionControl.State = msoButtonUp ' bouton relaché
End If
Application.ScreenUpdating = True
End Sub

A+

Benead

Le 16/10/2011 à 05:46

Bonjour Benead, le forum,

Super, merci beaucoup pour ta réponse c'est super.

Bonne journée

Rechercher des sujets similaires à "regrouper macros seule"