Aide Macro

[safranien]

Bonjour à tous,

j'essaie de me lancer dans l'automatisation des tâches sous excel. J'y pige pas grand chose au langage encore et pour l'instant je passe par l'enregistreur de macro et je fouine par ci par là sur les forums d'excel-download.
Je cherche à créer un fichier "vierge" dans lequel je viendrais coller dans l'onglet "détail source" une extraction issue d'un logiciel.
Ces données ne sont pas figées (il peut dans le temps y avoir plus ou moins d'installations qui s'ajoutent ou s'enlevent).
Donc pour l'instant ma "macro" (det3) vient recopier les données de l'onglet "detail source" dans l'onglet "DETAIL", elle supprime les lignes dont les cellules de la colonne C contient les termes CP, CPC, PF, PFC et PFI, elle supprime les colonnes B, L, M, N, O et P, masque la colonne E, passe les lignes à une hauteur de 23, centre tout horizontalement et verticalement et aligne a gauche la colonne D (si vous pouviez me dire si déjà cette partie est pas trop mal faite?).

Et pour la suite, je sêche (voir onglet "DETAIL(2)"). A savoir:

je voudrais que pour toutes les lignes existantes (de A1 à J205) les cellules adjacentes (de K à R) soient "encadrées. Et que de K1 à R1, il y ait le titre "COMMENTAIRES" centré sur plusieurs colonnes et avec la même mise en forme que les autres cellules de titres. Sachant que derrière ça, il faut que je fasse des sous-totaux (ce qui m'amènera très certainement vers vous pour un autre problème).

Mais déjà si vous pouviez m'aiguiller pour ce premier probleme, ca serait sympa.

Merci a tous.

PS: le résultat final que je souhaite obtenir est l'onglet "DETAIL(3).

 

[safranien]

Re : Aide Macro

Bonjour,

merci pour ta réponse Staple.

Minick, une autre question. Le code qui est dans ThisWorkbook, est ce que je peux le copier / coller dans un autre fichier que j'ai commencé à préparer (j'y ai ajouté des onglets par rapport a ce que je veux faire en plus etc...).
J'ai essayé de le faire, et en ouvrant mon autre ficier, j'ai une erreur de compilation: sub ou fonction non definie.

Ce qui induit deux autres questions: si je conserve ton fichier, est ce que je peux modifier le nom du menu et y a jouter d'autres sous menus avec d'autres macros sans avoir besoin de faire quoique ce soit sur le code qui est present dans thisworkbook?
et est ce que je peux ajouter donxc d'autres onglets egalement?

J'espere que je me suis exprimé correctement lol

Merci

 

[Minick]

Re : Aide Macro

Salut,

La reponse a toutesles questions est oui.

Pour utiliser un autre fichier, il faut copier egalement cette partie de code du Module1 du fichier joint precedemment.

Public Const SUPPRIMER As Byte = 0
Public Const AFFICHER As Byte = 1
Public Const MASQUER As Byte = 2

Sub MenuPerso(Action As Byte)
    Dim MonMenu  As CommandBarControl
    Dim MonBouton As CommandBarButton

    On Error Resume Next
        Set MonMenu = Application.CommandBars("Worksheet Menu Bar").FindControl(Tag:="Mon menu perso")
    On Error GoTo 0
    
    Select Case Action
        Case SUPPRIMER
            If Not MonMenu Is Nothing Then
                MonMenu.Delete
            End If
            
        Case AFFICHER
            If MonMenu Is Nothing Then
                Set MonMenu = Application.CommandBars("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, temporary:=True)
                MonMenu.Tag = "Mon menu perso"
                MonMenu.Caption = "Menu perso"
                Set MonBouton = MonMenu.Controls.Add(Type:=msoControlButton)
                MonBouton.Caption = "Mise en forme detail"
                MonBouton.OnAction = "Detail_Minick_3"
                Set MonBouton = Nothing
            End If
            MonMenu.Visible = True
        
        Case MASQUER
            If Not MonMenu Is Nothing Then
                MonMenu.Visible = False
            End If
        
    End Select

    Set MonMenu = Nothing
End Sub

Pour changer le nom du menu change dans cette ligne:

MonMenu.Caption = [B][COLOR=Red]"Menu perso"[/COLOR][/B]

Pour ajouter d'autres options au menu duplique cette partie autant de fois que necessaire:

Set MonBouton =  MonMenu.Controls.Add(Type:=msoControlButton)
MonBouton.Caption = [B][COLOR=Red]"Mise en forme detail"[/COLOR][/B] 'Titre de l'option
MonBouton.OnAction = [COLOR=Red][B]"Detail_Minick_3"[/B][/COLOR] 'Macro a lancer

 

[safranien]

Re : Aide Macro

Bonjour Minick,

c'est re-moi.
Tout d'abord encore merci pour les explications et toutes tes réponses.
Grace a toi, je vais pouvoir gagner pas mal de temps avec ce fichier.

Je voulais te demander, dans le cadre de mon "apprentissage", ton avis sur une modification du code.

En fait il s'agit de mettre au format nombre, deux chiffres apres la virgule avec séparateur de milliers, les colonnes G,H et I.

Est-ce que tu peux me dire si j'ai bien écrit? Et si je l'ai ecrit au bon endroit?

NbrLignes = .Range("A65526").End(xlUp).Row
         'Format cellules colonnes G,H et I
        With .Range("G2:H" & NbrLignes)
            .NumberFormat = "#,##0.00"
        End With
        With .Range("I2:I" & NbrLignes)
            .NumberFormat = "#,##0.00"
        End With
        'Format cellules colonne Ecart%
        With .Range("I2:I" & NbrLignes)
            .NumberFormat = "[Red]0.00%;[Blue]-0.00%"
            .FormulaR1C1 = "=IF(OR(RC[-1]=0,RC[-1]=""-""),""-"",RC[1]/RC[-1])"
        End With

Merci d'avance

 

[Minick]

Re : Aide Macro

Salut,

Oui c'est bien place et le code est bon, mais (desole... ), on peut faire plus court:
Remplace

With .Range("G2:H" & NbrLignes)
    .NumberFormat = "#,##0.00"
End With
With .Range("I2:I" & NbrLignes)
     .NumberFormat = "#,##0.00"
End With

par

.Range("G2:I" & NbrLignes).NumberFormat = "#,##0.00"

 

[safranien]

Re : Aide Macro

ok j essaie.

 

[safranien]

Re : Aide Macro

IMPECC !!!

Je continue mes modifs. Pour l'instant j'ai l'air de pas trop mal m'en sortir.
J'ai eu un peu de soucis avec un tableau que je voulais faire, où les sous totaux qont reduits afin que ne soient visibles que les totaux (c est a dire uniquement les lignes jaunes et vertes) mais sans les colonnes commentaires.

Sauf que je me retrouvais avec les sous totaux qui se mettaient en couleur pas du tout sur les lignes ou apparaissaient "Total", des cases qui restaient encadrees dans les colonnes O, P, Q R etc

J'ai "contourné" le problème en laissant le code d'origine (donc avec la construction des lignes commentaires) et à la fin une commande qui supprimer ces colonnes

'Suppression colonnes K a R
    Columns("K:R").Select
    Selection.Delete Shift:=xlToLeft

+ le changement de la mise en page, en passant de paysage, à portrait, et en changeant la largeur de la colonne D pour que le tableau prenne toute la largeur.

Voila, j'imagine que c'est pas le meilleur moyen de faire, mais c'est un bon début non?

 

[Minick]

Re : Aide Macro

Re,

Effectivement, ca peut arriver et cela et du au fait que quand on cree les MFC ce n'est pas la cellule A1 qui est active (plus exactement, une cellule de la 1ere ligne).
Je n'y avais pas pense...

Ajoute cette ligne juste avant la 1ere MFC.

.Cells(1, 1).Activate

apres

With .UsedRange

Tu pourras ensuite reprendre un code sans l'ajout des commentaires pour les supprimer ensuite.

 

[Minick]

Re : Aide Macro

j'ai mi avant With .UsedRange mais c'est apres, je corrige au dessus

 

[safranien]

Re : Aide Macro

COMME CA?

[COLOR="Red"].Cells(1, 1).Activate[/COLOR] 
        With .UsedRange
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=NON(ESTERREUR(CHERCHE(""Total"";$A1;1)))")
                With .Font
                    .Bold = True
                    .Italic = False
                End With
                        
                .Interior.ColorIndex = 35
            End With
            
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=NON(ESTERREUR(CHERCHE(""Total"";$B1;1)))")
                .Interior.ColorIndex = 36
            End With
            
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=NON(ESTERREUR(CHERCHE(""CENTRE DTH"";$D1;1)))")
                With .Font
                    .Bold = True
                    .Italic = False
                End With
                .Interior.ColorIndex = 33
            End With
        End With

 

[safranien]

Re : Aide Macro

Les sous totaux se refont bien mais j'ai tjrs la cellules de K a R qui sont encadrees.

 

[Minick]

Re : Aide Macro

Ca fonctionnera comme ca vu que le tableau commence toujours en A1.

Mais si on voulait etre tres rigoureux, il faudrait le mettre sous With .UsedRange et modifier
les formules utiliser dans les MFC pour prendre en compte la 1ere cellule de la plage et non pas A1 par defaut comme ici...
Si tu veux vraiment je ferais la modif...

 

[Minick]

Re : Aide Macro

Les sous totaux se refont bien mais j'ai tjrs la cellules de K a R qui sont encadrees.

Oui, ca c'etait juste pour les MFC.
Pour ne plus tenir compte des commentaires, il faut en plus
changer un peu les lignes concernant la MFC on est plus jusque la colonne R mais J
et pareil pour la mise en forme des totaux (les bordures)

 

[safranien]

Re : Aide Macro

effectivement, j'ai remplacé R par J dans le code des sous totaux. par contre, dans le code de la MFC, je ne vois a aucun endroit où remplacer un quelconque R par J.

Quoiqu'il en soit, ne t'embete pas a modifier le tout juste pour ca, je pense que ce que j'avais fait au depart, a savoir ajouter un code a la fin pour supprimer le colonnes K à R, peut convenir aussi, non? Meme si ce n'est pas tres rigoureux....lol

Je t'ai deja bien assez embeté comme ca je trouve..lol

 

[safranien]

Re : Aide Macro

Ca me donne ca (en rouge, les modifs)

Sub Synthese_Cumul()
    Dim NbrLignes As Long, CptLignes As Long
    Dim MarchesExclus As String
    
    MarchesExclus = ";CP;CPC;PF;PFC;PFI;"
    
    With Sheets("SYNTHESE CUMUL")
        Application.ScreenUpdating = False
        'Effacement des anciennes valeurs
        .Cells.Delete
        
        'Copie des colonnes de la source
        NbrLignes = Sheets("cumul source").Range("C65526").End(xlUp).Row
        Sheets("cumul source").Range("A13:A" & NbrLignes & ",C13:K" & NbrLignes).Copy .Range("A1")
        
        
        'Masquage de la colonne E
        .Columns("E").Hidden = True
        
        NbrLignes = .Range("A65526").End(xlUp).Row
        
        'Mise en numerique des valeurs
        .Range("K2:N" & NbrLignes).FormulaR1C1 = "=IF(RC[-4]=""-"",""-"",VALUE(RC[-4]))"
        .Calculate
        .Range("G2:J" & NbrLignes).Value = .Range("K2:N" & NbrLignes).Value
        .Range("K2:N" & NbrLignes).ClearContents
        
        'Suppression des Marches Exclus
        For CptLignes = NbrLignes To 2 Step -1
            If InStr(1, MarchesExclus, ";" & UCase(.Range("B" & CptLignes).Value) & ";") <> 0 Then
                .Rows(CptLignes).Delete
                NbrLignes = NbrLignes - 1
            End If
        Next
        
        .Columns("A").ColumnWidth = 26
        .Columns("C").ColumnWidth = 14
        [COLOR="Red"].Columns("D").ColumnWidth = 62[/COLOR]
        
        'Centrage et hauteur des cellules
        With .Range("A1:J" & NbrLignes)
            .RowHeight = 26
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("B1"), Order2:=xlAscending, Key3:=.Range("C1"), Order3:=xlAscending, Header:=xlYes
        End With
        
        'Alignement a gauche de la colonne D
        .Range("D1:D" & NbrLignes).HorizontalAlignment = xlLeft
        .Range("D1").HorizontalAlignment = xlCenter
        
        
        'Mise en forme de la colonne commentaire
        .Range("A1:A" & NbrLignes).Copy
        With .Range("K1:R" & NbrLignes)
            .PasteSpecial Paste:=xlPasteFormats
            .Borders(xlInsideVertical).LineStyle = xlNone
        End With
        .Range("K1:R1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("K1").Value = "Commentaires"
        
        'SOUS TOTAUX
        Application.DisplayAlerts = False
            NbrLignes = .Range("A65526").End(xlUp).Row
            .Range("A1:R" & NbrLignes).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8, 10), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
            NbrLignes = .Range("A65526").End(xlUp).Row
            .Range("A1:R" & NbrLignes).Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7, 8, 10), Replace:=False, PageBreaks:=False, SummaryBelowData:=True
        Application.DisplayAlerts = True
        ActiveSheet.Outline.ShowLevels RowLevels:=3
            
        'MFC
        With .UsedRange
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=NON(ESTERREUR(CHERCHE(""Total"";$A1;1)))")
                With .Font
                    .Bold = True
                    .Italic = False
                End With
                        
                .Interior.ColorIndex = 35
            End With
            
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=NON(ESTERREUR(CHERCHE(""Total"";$B1;1)))")
                .Interior.ColorIndex = 36
            End With
            
            With .FormatConditions.Add(Type:=xlExpression, Formula1:="=NON(ESTERREUR(CHERCHE(""CENTRE DTH"";$D1;1)))")
                With .Font
                    .Bold = True
                    .Italic = False
                End With
                .Interior.ColorIndex = 33
            End With
        End With
        
        NbrLignes = .Range("A65526").End(xlUp).Row
        
        'Format cellules colonnes G,H et J
        .Range("G2:J" & NbrLignes).NumberFormat = "#,##0.00"
        
        'Format cellules colonne Ecart%
        With .Range("I2:I" & NbrLignes)
            .NumberFormat = "[Red]0.00%;[Blue]-0.00%"
            .FormulaR1C1 = "=IF(OR(RC[-1]=0,RC[-1]=""-""),""-"",RC[1]/RC[-1])"
        End With
        
        
        'Mise en forme du total general
        With .Range("D" & NbrLignes)
            .Value = "TOTAL CENTRE DTH"
            .HorizontalAlignment = xlLeft
        End With
        .Range("A" & NbrLignes).Value = ""
        
        'Mise en forme des bordures des lignes de total
        For CptLignes = 2 To NbrLignes
            If .Range("B" & CptLignes).Value = "Total" Then
                .Rows(CptLignes).Delete
                CptLignes = CptLignes - 1
            ElseIf InStr(1, .Range("A" & CptLignes).Value, "Total") <> 0 _
                Or InStr(1, .Range("B" & CptLignes).Value, "Total") <> 0 Then
                .Range("A" & CptLignes & ":R" & CptLignes).Borders.LineStyle = xlContinuous
                .Range("K" & CptLignes & ":R" & CptLignes).Borders(xlInsideVertical).LineStyle = xlNone
            
            ElseIf InStr(1, .Range("D" & CptLignes).Value, "TOTAL") <> 0 Then
                .Range("A" & CptLignes & ":R" & CptLignes).Borders.LineStyle = xlContinuous
                .Range("A" & CptLignes & ":F" & CptLignes).Borders(xlInsideVertical).LineStyle = xlNone
                .Range("K" & CptLignes & ":R" & CptLignes).Borders(xlInsideVertical).LineStyle = xlNone
            End If
        Next CptLignes
        
        'Ajout du titre et mise en forme
        .Rows(1).Insert
        .Range("A1").FormulaR1C1 = "=MID(CELL(""nomfichier""),FIND(""["",CELL(""nomfichier""))+1,FIND(""."",CELL(""nomfichier""))-FIND(""["",CELL(""nomfichier""))-1)"
        .Range("F1").Value = "SYTHESE CUMUL"
        
        .Range("A1:D1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("F1:J1").HorizontalAlignment = xlCenterAcrossSelection
        
        With .Range("A1:D1,F1:J1")
            .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            
            With .Font
                .Name = "Arial"
                .Size = 24
            End With
        End With
        
       [COLOR="red"] 'Suppression colonnes K a R
        Columns("K:R").Select
    Selection.Delete Shift:=xlToLeft[/COLOR]
        
        'Mise en page
        With .PageSetup
            .PrintTitleRows = "$2:$2"
            .LeftHeader = ""
            .CenterHeader = "&F"
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = "Page &P"
            .RightFooter = ""
            .LeftMargin = Application.CentimetersToPoints(0.4)
            .RightMargin = Application.CentimetersToPoints(0.4)
            .TopMargin = Application.CentimetersToPoints(1)
            .BottomMargin = Application.CentimetersToPoints(0.8)
            .HeaderMargin = Application.CentimetersToPoints(0.4)
            .FooterMargin = Application.CentimetersToPoints(0.4)
            .Orientation = [COLOR="red"]xlPortrait[/COLOR]
            .Zoom = 59
        End With

        Application.ScreenUpdating = True
    End With
End Sub

 

[safranien]

Re : Aide Macro

Grrr encore un truc qui cloche !!!!

Cette fois j'ai modifié le code que j'ai posté précédemment pour avoir une synthese hors marchés CPI.

Mise a part le fait de rajouter "CPI" + changer le texte pour la selection de l'onglet, j'ai voulu modifié la taille de la police pour le titre puisque "SYNTHESE CUMUL HORS CPI" en police 24 débordait.

J'ai donc transformé

With .Range("A1:D1,F1:J1")
            .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            
            With .Font
                .Name = "Arial"
                .Size = 24
            End With

en

With .Range("A1:D1")
            .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            
            With .Font
                .Name = "Arial"
                .Size = 24
            End With
        End With
        
        With .Range("F1:J1")
            .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            
            With .Font
                .Name = "Arial"
                .Size = 16
            End With

Sauf que maintenant, je me retrouve avec une deuxieme page vide dans l'aperçu avant impression, meme en changeant le niveau de zoom dans le code !!!!!!!!????????

Est ce que c'est le fait d'avoir voulu modifié la police des cellules F1:J1 qui me fait ca?