fattah_5791
XLDnaute Occasionnel
Bonsoir,
je viens de concevoir une macro me permettant de copier une plage dans une feuille (crée) dans le mm classeur afin de la sauvegarder sous forme d'un classeur.
code:
Sub imprimerCC()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Index").Activate
ThisWorkbook.Unprotect "127261127261 Ea"
If Sheets("Base").Range("AM1").Value = 0 Then
GoTo fin
End If
Sheets("indicateurs").Visible = xlSheetVisible
Sheets("indicateurs").Unprotect "127261127261 Ea"
UserForm1.Show ' userform me permettant d'imprimer soit sous format XLS ou PDF ou imprimer directement sur imprimante
If UserForm1.OptionButton1.Value Then
Unload UserForm1
Dim chemin$, fichier$, Niveau$, classe$
Dim i%
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "IndicateursCC"
Niveau = Sheets("indicateurs").Range("AO1").Value
classe = Sheets("indicateurs").Range("AM1").Value
Sheets("indicateurs").Activate
Worksheets("indicateurs").Range("AG1:AV37").Select
Selection.Copy
Sheets("indicateursCC").Activate
Sheets("IndicateursCC").Range("A1").Select
Application.DisplayAlerts = False
With Selection
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.PasteSpecial Paste:=xlPasteColumnWidths
End With
Application.DisplayAlerts = True
Sheets("indicateurs").Activate
Sheets("indicateurs").ChartObjects("Graphique 2").Copy
Sheets("indicateursCC").Activate
Sheets("IndicateursCC").Range("A17").Select
Selection.PasteSpecial Paste:=xlPasteFormats
For i = 1 To 34
ActiveSheet.Rows(i).RowHeight = Sheets("Indicateurs").Rows(i).RowHeight
Next i
chemin = ThisWorkbook.Path
fichier = chemin & "\" & "IndicateursCC_" & Niveau & "_" & classe & ".xlsx"
ActiveSheet.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fichier
Application.DisplayAlerts = True
ActiveWorkbook.Close
MsgBox ("Le fichier exporté a été enregistré sous le nom : " & fichier)
Application.DisplayAlerts = False
Sheets("IndicateursCC").delete
Application.DisplayAlerts = True
ElseIf UserForm1.OptionButton2.Value Then
Unload UserForm1
Dim Vbprinter
Vbprinter = Application.Dialogs(xlDialogPrinterSetup).Show
If Vbprinter = True Then
Sheets("indicateurs").Activate
Range(Cells(1, 33), Cells(37, 48)).Select
Selection.PrintOut Copies:=1
Else: GoTo fin
End If
End If
fin:
Sheets("indicateurs").Visible = xlSheetVeryHidden
Sheets("indicateurs").Protect "127261127261 Ea"
' masquer ttes les feuilles sauf "Index"
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Index" Then
Sheets(i).Visible = xlSheetVeryHidden
End If
Next i
ThisWorkbook.Protect "127261127261 Ea"
Sheets("Index").Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
la 1ère execution se passe parfaitement en choisissant d'imprimer en XLS, et si je recommence la mm macro, le code se plante au niveau de :
Worksheets("indicateurs").Range("AG1:AV37").Select
Selection.Copy
Merci de m'aider
Excel 2010
windows 10
je viens de concevoir une macro me permettant de copier une plage dans une feuille (crée) dans le mm classeur afin de la sauvegarder sous forme d'un classeur.
code:
Sub imprimerCC()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Index").Activate
ThisWorkbook.Unprotect "127261127261 Ea"
If Sheets("Base").Range("AM1").Value = 0 Then
GoTo fin
End If
Sheets("indicateurs").Visible = xlSheetVisible
Sheets("indicateurs").Unprotect "127261127261 Ea"
UserForm1.Show ' userform me permettant d'imprimer soit sous format XLS ou PDF ou imprimer directement sur imprimante
If UserForm1.OptionButton1.Value Then
Unload UserForm1
Dim chemin$, fichier$, Niveau$, classe$
Dim i%
Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = "IndicateursCC"
Niveau = Sheets("indicateurs").Range("AO1").Value
classe = Sheets("indicateurs").Range("AM1").Value
Sheets("indicateurs").Activate
Worksheets("indicateurs").Range("AG1:AV37").Select
Selection.Copy
Sheets("indicateursCC").Activate
Sheets("IndicateursCC").Range("A1").Select
Application.DisplayAlerts = False
With Selection
.PasteSpecial Paste:=xlPasteFormats
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.PasteSpecial Paste:=xlPasteColumnWidths
End With
Application.DisplayAlerts = True
Sheets("indicateurs").Activate
Sheets("indicateurs").ChartObjects("Graphique 2").Copy
Sheets("indicateursCC").Activate
Sheets("IndicateursCC").Range("A17").Select
Selection.PasteSpecial Paste:=xlPasteFormats
For i = 1 To 34
ActiveSheet.Rows(i).RowHeight = Sheets("Indicateurs").Rows(i).RowHeight
Next i
chemin = ThisWorkbook.Path
fichier = chemin & "\" & "IndicateursCC_" & Niveau & "_" & classe & ".xlsx"
ActiveSheet.Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=fichier
Application.DisplayAlerts = True
ActiveWorkbook.Close
MsgBox ("Le fichier exporté a été enregistré sous le nom : " & fichier)
Application.DisplayAlerts = False
Sheets("IndicateursCC").delete
Application.DisplayAlerts = True
ElseIf UserForm1.OptionButton2.Value Then
Unload UserForm1
Dim Vbprinter
Vbprinter = Application.Dialogs(xlDialogPrinterSetup).Show
If Vbprinter = True Then
Sheets("indicateurs").Activate
Range(Cells(1, 33), Cells(37, 48)).Select
Selection.PrintOut Copies:=1
Else: GoTo fin
End If
End If
fin:
Sheets("indicateurs").Visible = xlSheetVeryHidden
Sheets("indicateurs").Protect "127261127261 Ea"
' masquer ttes les feuilles sauf "Index"
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Index" Then
Sheets(i).Visible = xlSheetVeryHidden
End If
Next i
ThisWorkbook.Protect "127261127261 Ea"
Sheets("Index").Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
la 1ère execution se passe parfaitement en choisissant d'imprimer en XLS, et si je recommence la mm macro, le code se plante au niveau de :
Worksheets("indicateurs").Range("AG1:AV37").Select
Selection.Copy
Merci de m'aider
Excel 2010
windows 10