1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
|
Sub EnregistrementExcel()
Dim DateTab As String, RepDest As String, RefAgent As String, VerifExist As String, CodeTab As String, NomTableau As String
DateTab = Format(Date, "yyyymmdd")
RepDest = "C:\DESTINATION\MACHINTRUC\"
RefAgent = Application.UserName
CodeTab = ActiveSheet.Name
NomTableau = ActiveSheet.Cells(5, 7).Value & " - " & DateTab & " - " & CodeTab & " - " & RefAgent & ".xlsx"
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftFooter = "ETABLISSEMENT / Service / " & Sheets("ACCUEIL").Range("C8")
End With
If IsEmpty(Cells(2, 1)) = True Then
MsgBox ("Veuillez renseigner la référence du correspondant avant enregistrement au format Excel")
Range("A2").Select
Exit Sub
End If
If IsEmpty(Cells(5, 1)) = True Then
MsgBox ("Veuillez renseigner le type d'anomalie avant enregistrement au format Excel")
Range("A5").Select
Exit Sub
End If
If MsgBox("Confirmez-vous l'enregistrement de ce fichier au format Excel ?", vbOKCancel) = vbOK Then
VerifExist = Dir(RepDest & NomTableau)
If VerifExist = "" Then
Application.DisplayAlerts = False
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=RepDest & NomTableau
'-------------- C'EST LA QUE CA COINCE ---------------------------------------------------------------------------------------------------
ActiveSheet.Shapes.Range(Array("Picture 6", "Picture 5", "Picture 4", "Picture 3", "Picture 2", "Picture 1")).Select
Selection.Delete
'------------------------------------------------------------------------------------------------------------------------------------------------
ActiveWorkbook.Close
MsgBox ("votre fichier a bien été enregistré sous : " & RepDest & NomTableau)
Application.DisplayAlerts = True
Else
If MsgBox("Le fichier que vous voulez enregistrer existe déjà. Souhaitez-vous le remplacer ?", vbYesNo) = vbYes Then
Application.DisplayAlerts = False
ThisWorkbook.ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:=RepDest & NomTableau
'-------------- C'EST LA QUE CA COINCE ---------------------------------------------------------------------------------------------------
ActiveSheet.Shapes.Range(Array("Picture 6", "Picture 5", "Picture 4", "Picture 3", "Picture 2", "Picture 1")).Select
Selection.Delete
'------------------------------------------------------------------------------------------------------------------------------------------------
ActiveWorkbook.Close
MsgBox ("votre fichier a bien été enregistré sous : " & RepDest & NomTableau)
Application.DisplayAlerts = True
Else
MsgBox ("Fichier non enregistré au format Excel")
End If
End If
End If
End Sub |
Partager