Aide Macro

safranien

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

Pièces jointes

  • TDB NOVEMBRE 2008.xls
    40.5 KB · Affichages: 74

Minick

XLDnaute Impliqué
Re : Aide Macro

Salut,

Une proposition parmi d'autres:
Code:
Sub Detail()
    Dim NbrLignes As Long, CptLignes As Long
    Dim MarchesExclus As String
    
    MarchesExclus = ";CP;CPC;PF;PFC;PFI;"
    
    With Sheets("DETAIL")
        Application.ScreenUpdating = False
        'Effacement des anciennes valeurs
        .UsedRange.ClearContents
        
        'Copie des colonnes de la source
        NbrLignes = Sheets("detail source").Range("C65526").End(xlUp).Row
        Sheets("detail source").Range("A12:A" & NbrLignes & ",C12:K" & NbrLignes).Copy .Range("A1")
        
        'Masquage de la colonne E
        .Columns("E").Hidden = True
        
        'Suppression des Marches Exclus
        NbrLignes = NbrLignes - 11
        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

        'Centrage et hauteur des cellules
        With .Range("A1:J" & NbrLignes)
            .RowHeight = 23
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        
        'Alignement a gauche de la colonne D
        .Range("D1:D" & NbrLignes).HorizontalAlignment = xlLeft
        
        'Mise en forme de la colonne commentaire
        .Range("A1:A" & CptLignes).Copy
        With .Range("K1:R" & CptLignes)
            .PasteSpecial Paste:=xlPasteFormats
            .Borders(xlInsideVertical).LineStyle = xlNone
        End With
        .Range("K1:R1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("K1").Value = "Commentaires"
        Application.ScreenUpdating = True
    End With
End Sub

Ton code est fonctionnel mais il faut limiter voir eliminer les 'Select'.
 

Modeste

XLDnaute Barbatruc
Re : Aide Macro

Bonjour safranien, salut Minick,

Comme j'y ai travaillé (et pas vu assez tôt que Minick m'avait largement devancé :rolleyes:) une proposition à peine différente ... mais sûrement pas "meilleure".
 

Pièces jointes

  • safranien.xls
    48.5 KB · Affichages: 85

safranien

XLDnaute Occasionnel
Re : Aide Macro

bonjour,

merci pour vos reponses. Minick, j'ai fait un copié collé de ton code dans un nouveau module et quand je le lance, il ne se passe rien.
Je n'ai pas testé la réponse de modeste encore.

J'ai surmeent mal du faire qqch.
 

Minick

XLDnaute Impliqué
Re : Aide Macro

Re,

Rien du tout c'est bizarre, par contre, j'avais un erreur dans une variable qui empeche le formatage des lignes commentaires.

Modif en rouge

Code:
Option Explicit

Sub Detail()
    Dim NbrLignes As Long, CptLignes As Long
    Dim MarchesExclus As String
    
    MarchesExclus = ";CP;CPC;PF;PFC;PFI;"
    
    With Sheets("DETAIL")
        Application.ScreenUpdating = False
        'Effacement des anciennes valeurs
        .UsedRange.ClearContents
        
        'Copie des colonnes de la source
        NbrLignes = Sheets("detail source").Range("C65526").End(xlUp).Row
        Sheets("detail source").Range("A12:A" & NbrLignes & ",C12:K" & NbrLignes).Copy .Range("A1")
        
        'Masquage de la colonne E
        .Columns("E").Hidden = True
        
        'Suppression des Marches Exclus
        NbrLignes = NbrLignes - 11
        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

        'Centrage et hauteur des cellules
        With .Range("A1:J" & NbrLignes)
            .RowHeight = 23
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        
        'Alignement a gauche de la colonne D
        .Range("D1:D" & NbrLignes).HorizontalAlignment = xlLeft
        
        'Mise en forme de la colonne commentaire
        .Range("A1:A" & [B][COLOR=Red]NbrLignes[/COLOR][/B]).Copy
        With .Range("K1:R" & [COLOR=Red][B]NbrLignes[/B][/COLOR])
            .PasteSpecial Paste:=xlPasteFormats
            .Borders(xlInsideVertical).LineStyle = xlNone
        End With
        .Range("K1:R1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("K1").Value = "Commentaires"
        Application.ScreenUpdating = True
    End With
End Sub
 

safranien

XLDnaute Occasionnel
Re : Aide Macro

La proposition de Modeste donne qqch de sympa. A part que ca me créée un nouvel onglet au lieu de venir copier les données dans l'onglet "DETAIL" existant (qui est vierge a la base). Sinon il faudra que je renomme le nouvelle onglet par la macro de "detail source (2)" en "DETAIL".
Et le deuxième point, c'est que je ne veux pas que les cases K à R aient des bordures sur les 4 cotes mais uniquement une bordure gauche de la colonne K, une bordure droite de la colonne R et les bordures horizontales de toutes les lignes, comme si les cellules des colonnes K à R etaient fusionnees.

Mais je vais essayé de combiner vos codes avec ce que j'ai fait via l'enregistreur de macro.

Merci
 

Minick

XLDnaute Impliqué
Re : Aide Macro

Re,

Code:
Option Explicit

Sub Detail()
    Dim NbrLignes As Long, CptLignes As Long
    Dim MarchesExclus As String
    
    MarchesExclus = ";CP;CPC;PF;PFC;PFI;"
    
    With Sheets("DETAIL")
        Application.ScreenUpdating = False
        'Effacement des anciennes valeurs
        .UsedRange.ClearContents
        
        'Copie des colonnes de la source
        NbrLignes = Sheets("detail source").Range("C65526").End(xlUp).Row
        Sheets("detail source").Range("A12:A" & NbrLignes & ",C12:K" & NbrLignes).Copy .Range("A1")
        
        'Masquage de la colonne E
        .Columns("E").Hidden = True
        
        'Suppression des Marches Exclus
        NbrLignes = NbrLignes - 11
        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

        'Centrage et hauteur des cellules
        With .Range("A1:J" & NbrLignes)
            .RowHeight = 23
            .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
        
        '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"
        Application.ScreenUpdating = True
    End With
End Sub
 

safranien

XLDnaute Occasionnel
Re : Aide Macro

Merci pour le temps consacré a m'aider dans mon projet.
Minick, ton code semble fonctionner. Par contre je me retrouve avec les colonnes A et D qui sont vachement reduites.
Est ce qu on peux faire en sorte que la colonne A fasse 24 de largeur et la D fasse 35?

Merci encore et bonne nuit (j'essaie de m'instruire en meme temps lol)
 

Minick

XLDnaute Impliqué
Re : Aide Macro

Salut,

Code:
Option Explicit

Sub Detail()
    Dim NbrLignes As Long, CptLignes As Long
    Dim MarchesExclus As String
    
    MarchesExclus = ";CP;CPC;PF;PFC;PFI;"
    
    With Sheets("DETAIL")
        Application.ScreenUpdating = False
        'Effacement des anciennes valeurs
        .UsedRange.ClearContents
        
        'Copie des colonnes de la source
        NbrLignes = Sheets("detail source").Range("C65526").End(xlUp).Row
        Sheets("detail source").Range("A12:A" & NbrLignes & ",C12:K" & NbrLignes).Copy .Range("A1")
        
        'Masquage de la colonne E
        .Columns("E").Hidden = True
        
        'Suppression des Marches Exclus
        NbrLignes = NbrLignes - 11
        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 = 24
        .Columns("D").ColumnWidth = 35
        
        'Centrage et hauteur des cellules
        With .Range("A1:J" & NbrLignes)
            .RowHeight = 23
            .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
        
        '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"
        Application.ScreenUpdating = True
    End With
End Sub
 

safranien

XLDnaute Occasionnel
Re : Aide Macro

Re-moi,

j'ai modifié le code pour changer qques petits trucs.
J'ai essayé d'ajouter un code pour faire des sous totaux, une mise en forme conditionnelle et une partie de la mise en forme pour la colonne Ecart%:

Sub Detail_Minick()
Dim NbrLignes As Long, CptLignes As Long
Dim MarchesExclus As String

MarchesExclus = ";CP;CPC;PF;PFC;PFI;"

With Sheets("DETAIL")
Application.ScreenUpdating = False
'Effacement des anciennes valeurs
.UsedRange.ClearContents

'Copie des colonnes de la source
NbrLignes = Sheets("detail source").Range("C65526").End(xlUp).Row
Sheets("detail source").Range("A12:A" & NbrLignes & ",C12:K" & NbrLignes).Copy .Range("A1")

'Masquage de la colonne E
.Columns("E").Hidden = True

'Suppression des Marches Exclus
NbrLignes = NbrLignes - 11
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 = 40

'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

'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("K2:R2").HorizontalAlignment = xlCenterAcrossSelection
.Range("K2").Value = "Commentaires"
Application.ScreenUpdating = True

'SOUS TOTAUX
Range("G8").Select
Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8, 10) _
, Replace:=True, PageBreaks:=False, SummaryBelowData:=True
Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7, 8, 10) _
, Replace:=False, PageBreaks:=False, SummaryBelowData:=True

'MFC
Columns("A:R").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTERREUR(CHERCHE(""Total"";$A1;1)))"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
End With
Selection.FormatConditions(1).Interior.ColorIndex = 35
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTERREUR(CHERCHE(""Total"";$B1;1)))"
Selection.FormatConditions(2).Interior.ColorIndex = 36
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=NON(ESTERREUR(CHERCHE(""CENTRE DTH"";$D1;1)))"
With Selection.FormatConditions(3).Font
.Bold = True
.Italic = False
End With
Selection.FormatConditions(3).Interior.ColorIndex = 33

'Format cellules colonne Ecart%
Columns("I:I").Select
Selection.NumberFormat = "[Red]0.00%;[Blue]-0.00%"

End With
End Sub


A partir de là, je sêche. Je joins le résultat de ce que j'aimerais réussir à faire.
Ce qu'il me reste à résoudre:

_ lorsque les sous totaux sont faits, il y a trois lignes qui s'ajoutent en bas de tableaux. J'aimerais que ces lignes aient le même format que les autres lignes sauf pour la derniere ou il faudrait qu il y ait de marqué "TOTAL CENTRE DTH" en D (centré vert/hor) et que cela fasse un "cadre" de la cellule A à la cellule D (heu je sais pas si c'est tres clair lol)

_ Appliquer le format "[Rouge]0,00%;[Bleu]-0,00%" à toutes les cellules de la colonne I (Ecart%) et que ces cellules soient calculées en faisant J/H.

_ Sur la ligne 1, une formule qui reprend le nom du fichier (celle la je l'ai trouvée) et que le texte soit centré sur plusieurs cellules entre A et D.
Pareil pour le texte entre les cellules F et J avec une formule qui reprend le nom de l'onglet (j'en avais trouvé une mais comme par la suite je vais avoir d'autres onglets dans ce fichier, la formule m'affichait systématiquement le nom du dernier onglet dans lequel j'avais tapé la formule, sur tous les onglets où j'avais deja tapé cette formule)

_ Et eventuellement la mise en page comme dans le fichier joint

Merci encore par avance de l'aide que vous pourrez m'apporter. Une fois ce fichier finalisé, j'essaierai de jonglet avec les différents codes pour d'autres onglets que j'ai à faire également.

Bonne soirée

Cordialement.
 

Pièces jointes

  • TDB P1 (macro) ED RESULTAT SOUHAITE.xls
    29 KB · Affichages: 63

Minick

XLDnaute Impliqué
Re : Aide Macro

Salut,

Le Next est ici utilise pour la boucle For.
Code:
Pour i=0 a 10
....
Suivant
donne
Code:
For 1=0 To 10
....
Next


Le With est une facilite d'ecriture:
Code:
Range("A1").Font.Name="Arial"
Range("A1").Font.Size=10
Range("A1").Font.ColorIndex=7
Donne
Code:
With Range("A1").Font
    [SIZE=4][COLOR=Red].[/COLOR][/SIZE]Name="Arial"
    [SIZE=4][COLOR=Red].[/COLOR][/SIZE]Size=10
    [SIZE=4][COLOR=Red].[/COLOR][/SIZE]ColorIndex=7
End With
Tu noteras en rouge, le point pour dire que la propriete utilise (Name, Size et Colorindex)
est une propriete de Range("A1").Font


Pour le reste, regarde si ca te convient.
Code:
Sub Detail_Minick()
    Dim NbrLignes As Long, CptLignes As Long
    Dim MarchesExclus As String
    
    MarchesExclus = ";CP;CPC;PF;PFC;PFI;"
    
    With Sheets("DETAIL")
        Application.ScreenUpdating = False
        'Effacement des anciennes valeurs
        .Cells.Delete
        
        'Copie des colonnes de la source
        NbrLignes = Sheets("detail source").Range("C65526").End(xlUp).Row
        Sheets("detail source").Range("A12:A" & NbrLignes & ",C12:K" & NbrLignes).Copy .Range("A1")
        
        'Masquage de la colonne E
        .Columns("E").Hidden = True
        
        'Suppression des Marches Exclus
        NbrLignes = NbrLignes - 11
        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 = 40
        
        '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" & NbrLignes).HorizontalAlignment = xlLeft
        
        '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
            .UsedRange.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(7, 8, 10), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
            .UsedRange.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(7, 8, 10), Replace:=False, PageBreaks:=False, SummaryBelowData:=True
        Application.DisplayAlerts = True
            
        '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 colonne Ecart%
        With .Range("I2:I" & NbrLignes)
            .NumberFormat = "[Red]0.00%;[Blue]-0.00%"
            .FormulaR1C1 = "=IF(RC[-1]=0,""-"",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 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 = "DETAIL"
        
        .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
        
        'Mise en page
        With .PageSetup
            .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 = xlLandscape
            .Zoom = 59
        End With

        Application.ScreenUpdating = True
    End With
End Sub
 

Discussions similaires

Réponses
12
Affichages
306

Statistiques des forums

Discussions
312 206
Messages
2 086 226
Membres
103 159
dernier inscrit
FBallea