Rapport de message :*
 

Re: copier coller dans un même classeur

Titre du sujet : Re: copier coller dans un même classeur
par Mth le 16/04/2013 00:23:56

Bonsoir ocealimer, bonsoir le forum,

Pour imprimer, je te propose de rajouter ce code:
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
Il s'écrit tout seul avec l'enregistreur de macros, mais je te mets en PJ ce que j'ai trouvé sur les arguments de cette macro Excel4

Pour Sauvegarder ta feuille je te propose ceci, à adapter
Option Explicit
Sub SauvFeuille()

'Chemin = celui du fichier, à adapter
'Nom= "FicInterv_xxx" avec xxx= n° intervention, à adapter

Dim Chemin As String, NomFic As String

Chemin = ThisWorkbook.Path & ""
NomFic = Format(Sheets("DI").Range("B6"), "000000")

If NomFic <> "" Then
    'crée une copie de la feuille active
    ActiveSheet.Copy
   
    'Source Silkyroad, permet de retirer le code VBA dans le classeur sauvegardé
    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
        .DeleteLines 1, .CountOfLines
    End With
   
    'Bloque les fenêtre d'alerte de l'application
    Application.DisplayAlerts = False
   
    'Format de fichier 56= Excel 97-2003
    ActiveWorkbook.SaveAs Chemin & NomFic, FileFormat:=56
    'Rétablit les fenêtres d'alerte
    Application.DisplayAlerts = True
   
    'Ferme le fichier Actif (qui est le fichier de sauvegarde)
    ActiveWorkbook.Close
End If


End Sub

et ... une petite correction, que tu trouveras à plusieurs endroits dans ton fichier joint:

ActiveSheet.Range("B5") = Date

ceci permet de figer la date du jour au lieu d'avoir une formule qui se recalcule à chaque fois

J'ai également mis ceci en fin de code, pour incrémenter mais aussi remettre les zone de saisie à blanc:

'Incrémente le n° intervention et remet le formulaire à blanc
With Sheets("DI")
    .Range("B6") = .Range("B6") + 1
    .Range("B7:B12").ClearContents
End With

Vois si cela peut t'aider,

Très bonne soirée,

mth