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

 

[Minick]

Re : Aide Macro

Salut,

Si tu pouvais joindre ton fichier, pour essayer de comprendre...

 

[safranien]

Re : Aide Macro

Salut,

je te joins le fichier.

J'en profite o) pour te poser une autre question (je sais j'abuse. hésite pas a me dire que je te soule hein !!!! )

J'explique:
le fichier que tu m'as plus qu'aidé à créer, s'appelle TDB P1 VIERGE. Chaque fin de mois, je vais créer un dossier avec le nom du mois (donc là, AVRIL 2010) et dedans j'y ferais une copie de ce fichier que je renommerai TDB P1 AVRIL 2010. Je l'ouvrirai, j'y collerai les données "detail source" et "cumul source" et je lancerai les macros pour tout mettre en forme.

C'est là qu'arrive ma question: est-il possible d'avoir une macro supplémentaire qui lorsqu'elle sera sélectionnée, créera une copie du fichier ouvert (dans le meme dossier) mais sans aucune macro dedans (une copie qui s'appellerait par exemple RESULTATS P1 AVRIL 2010) ??????
Je pose cette question car il s'agit d'un tableau que j'envoie par la suite à plein de personnes et je n'ai pas envie que certaines aient l'idée de s'approprier "mon" travail (je sais, ca peut paraitre bete mais bon....)

 

[Minick]

Re : Aide Macro

Re,

Ci-joint les modifs.

Pour la mise en page il fallait descendre un peu plus le zoom.
J'ai modifie l'histoire des commentaires (c'est un peu mieux comme ca quand meme).
J'ai aussi ajouter un test sur le separateur decimal, dans ta source il y a des points et des virgules donc ca peu coincer sur les calculs.
Et il y a une procedure supplementaire que je te laisse decouvrir.

Autre point, auquel tu n'est peut etre pas confronte, sur les sous totaux.
Il y a un bug (selon la version) avec cette option d'excel quand on les imbriques.
Par exemple: Pour un sous total par Chemin puis par Marche, si il n'y a qu'une seul ligne de marche on se retrouve avec le sous total de Marche
en dessous du sous total de Chemin.
Avec le fichier que tu as joins on a ce cas pour la 1ere ligne (apres le tri).
Si tu as ce probleme comme moi je l'ai eu, suis ce lien pour le resoudre.

 

[safranien]

Re : Aide Macro

re,

donc effectivement, j'avais changé le niveau du zoom mais ca me faisait toujours la meme chose. ce qu'il y a de "marrant", c'est que si je reprends le fichier que je t'ai envoyé et que j'y met le meme niveau de zoom que ce que tu m'as retourné, effectivement, je n'ai plus de deuxieme page, mais la limite de bordure de la feuille n'est plus "collée" au tableau mais à la colonne adjacente vide (la K) !!! bizarre non???? lol bref, c'est pas le plus important ça. je vais faire l'essai avec le fichier normal.

Concernant le test sur le separateur de decimal, heu, j'ai pas vu qu'il y a des points dans les colonnes où se trouvent des chiffres (??) Mais deux précautions valent mieux qu'une et cette formule pourra tjrs me servir dans l'avenir lol

Et la procédure supplémentaire......TERRIIIIIIIBLE !!!!!!!

J'ai hate de mettre en application à la fin du mois.

Je vais recopier le code dans mon fichier.

Juste pour être sûr que j'ai bien vu, la modif. que tu as fait pour l'histoire des colonnes commentaires, c'est que donc il n'y a plus le code de création des colonnes commentaires et tu as modifié le code de la MFC, c'est ca? Ou y a autre chose en plus que je n'aurais pas vu?

 

[Minick]

Re : Aide Macro

Re,

Sur les MFC il n'y avait rien a faire en fait (mise a part selectionner la cellule A1).
J'ai modifie egalement le bloc 'Mise en forme des bordures des lignes de total
Et je crois que c'est tout, enfin je crois

 

[safranien]

Re : Aide Macro

Bonjour Minick,

je reviens à nouveau vers pour un petit soucis. La dernière formule que tu m'as donné, pour faire la synthese Hors CPI me provoque un probleme de virgule dans les chiffres. Pour certains, elle est placée au bon endroit et pour d'autres pas.
De plus, si je compare les resultats entre ta formule et celle que j'avais faite ou je me contentais juste de supprimer les colonnes commentaires, il y a des differences de resultats.

Je n'arrive pas a faire une capture dd'ecran qui soit lisible et qui fasse moin de 49 Ko!!!
Je te redonne donc le code que j'avais utilisé pour faire la synthese modifié avec lequel tu pourras constater qu'il y a des sous totaux qui n'ont pas la meme valeur

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
        .Columns("D").ColumnWidth = 62
        
        '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 = "SYNTHESE 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
        
        'Suppression colonnes K a R
        Columns("K:R").Select
    Selection.Delete Shift:=xlToLeft
        
        'Mise en page
        With .PageSetup
            .PrintTitleRows = "$2:$2"
            .LeftHeader = ""
            .CenterHeader = "&F"
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = "&A"
            .RightFooter = "Page &P"
            .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 = xlPortrait
            .Zoom = 59
        End With

        Application.ScreenUpdating = True
    End With
End Sub

Est ce que tu peux m'aider a nouveau stp?

Merci

 

[safranien]

Re : Aide Macro

je pense que c'est la formule de vérification de séparateur de décimal qui provoque ce probleme

 

[Minick]

Re : Aide Macro

Salut,

Effectivement, sur un autre pc j'ai le meme probleme.
Il semble interpreter la virgule comme un separateur de milliers mais
je ne vois pas pourquoi.
Si tu n'as pas les problemes que j'avais eu avec le separateur decimal
commente cette partie.
J'essaie de trouver le pourquoi et te tiens au courant.

 

[Minick]

Re : Aide Macro

Re,

Un essai en gerant le . ou la virgule dans la formule de mise en numerique.

Remplace:

        'Verification du separateur decimal
        If Application.DecimalSeparator = "." Then
            .Range("G2:J" & NbrLignes).Replace what:=",", replacement:="."
        Else
            .Range("G2:J" & NbrLignes).Replace what:=".", replacement:=","
        End If
        
        '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

par:

        'Verification du separateur decimal et mise en numerique des valeurs
        If Application.DecimalSeparator = "." Then
            .Range("K2:N" & NbrLignes).FormulaR1C1 = "=IF(RC[-4]=""-"",""-"",VALUE(SUBSTITUTE(RC[-4],"","",""."")))"
        Else
            .Range("K2:N" & NbrLignes).FormulaR1C1 = "=IF(RC[-4]=""-"",""-"",VALUE(SUBSTITUTE(RC[-4],""."","","")))"
        End If
        .Calculate
        
        .Range("G2:J" & NbrLignes).Value = .Range("K2:N" & NbrLignes).Value
        .Range("K2:N" & NbrLignes).ClearContents

 

[safranien]

Re : Aide Macro

ok je vais essayer.

mais comme je t'avais dit, je n'ai jamais vu de . dans mon fichier source pour separer les chiffres donc est ce utile de se prendre la tete avec ca? (je sais pas ou t en as vu des . toi lol) mais j'essaie quand meme
je te tiens au courant
merci

 

[safranien]

Re : Aide Macro

Bon, ca a l'air de fonctionner.
Je ferai le tableau manuellement a la fin du mois et je lancerai les macros en comparaison pour voir si tout concorde.

Merci Minick

Bonne journee a toi