pompaero
XLDnaute Impliqué
Bonjour le forum
J'aimerai de l'aide pour le petit projet que je suis en train de construire, j'ai déjà bien avancé, j'en suis arrivé à l'enregistrement pour archive.
Il s'agit d'un classeur pour mon travail que l'on va utiliser tous les jours. et par l'ensemble du personnel du service.
Il s'agit de copier l'onglet MC vierge vers le classeur Archive MC, créer un pdf puis remettre à l'initiale. Pour cela j'ai chercher sur le net et le forum puis arrivé à faire ces quelques macros, mais je l'avoue reste du niveau de débutant. C'est la que j'aimerai le savoirs des pro afin d'améliorer ces macros en un code fonctionnel et surtout sans bug.
Est-il possible de mettre un MsgBox de confirmation en début de code ? comme par ex : Souhaitez-vous clôturer cette journée ?
Puis si la date existe deja, pouvoir l'enregistrer tout de même (MC 28-08-18 et 28-08-18(1) )
Mes codes :
* fin-service (module 1)
'''MACRO affichage heure quand on valide fin de service
Sub ligne()
ActiveCell.Offset(-0, -1) = Format(Now, "hh:mm")
End Sub
'##########
Sub fin_service()
Dim monClass As Workbook, Chemin As String
Set monClass = ThisWorkbook
Chemin = monClass.Path
Application.EnableEvents = False
[C65536].End(xlUp)(2).Select
ActiveCell = "Journée clôturée" '"Fin de service"
Call ligne
Range("A7").Select
With monClass
Workbooks.Open ("C:\Users\F Leroy\Desktop\ADMINISTRATIF France\DOCUMENTS ENREGISTRES\Main courante\Archives M C.xlsm") 'Chemin & "\Archives M-C.xlsm" 'A ADAPTER !!!!!
.Sheets("MC vierge").Copy after:=Workbooks("Archives M C.xlsm").Sheets(1)
End With
ActiveSheet.Name = "MC du " & Format(Range("C2"), "dd-mm-yy") 'Format(Date, "dd-mm-yy")
'[C4] = Date
ActiveSheet.Protect Password:="1234"
Workbooks("Archives M C.xlsm").Close True
monClass.Sheets("MC vierge").Activate
Range("A1").Select
Application.EnableEvents = True
End Sub
* SaveAsPDF
Sub SaveAsPDF() 'Enregistrement MC Vierge en pdf
Dim FileN$
FileN = Format(Year(Date), "00") & Format(Month(Date), "00") & _
Format(Day(Date), "00") & " " & Format(Time, "hhmmss") & ".pdf"
ChDir "C:\Users\F Leroy\Desktop\ADMINISTRATIF France\Document originale NE PAS TOUCHER\Main-courante"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\F Leroy\Desktop\ADMINISTRATIF France\DOCUMENTS ENREGISTRES\Main courante\M C-pdf\M-C " & FileN, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Main courante enregistrée en PDF", vbInformation, "Enregistrement en PDF"
End Sub
* Mise à l'initial
Sub Reinitialise()
[I2,K2,D5,D8 9,D12 13,D16 17,B20:C20,M20:N20] = ""
[B19 19] = False
[H18] = 5
[C2] = Date
'reste à supprimer les lignes à partir de la 23
End Sub
Soucis que je rencontre également, est que les liens et codes des objets restent et créé des liaisons inutile, serait-il possible de les supprimer à l'enregistrement dans le classeur Archive MC ?
Merci à vous par avance.
Cdlt pompaero
Je joins le classeur de l'onglet à copier.
J'aimerai de l'aide pour le petit projet que je suis en train de construire, j'ai déjà bien avancé, j'en suis arrivé à l'enregistrement pour archive.
Il s'agit d'un classeur pour mon travail que l'on va utiliser tous les jours. et par l'ensemble du personnel du service.
Il s'agit de copier l'onglet MC vierge vers le classeur Archive MC, créer un pdf puis remettre à l'initiale. Pour cela j'ai chercher sur le net et le forum puis arrivé à faire ces quelques macros, mais je l'avoue reste du niveau de débutant. C'est la que j'aimerai le savoirs des pro afin d'améliorer ces macros en un code fonctionnel et surtout sans bug.
Est-il possible de mettre un MsgBox de confirmation en début de code ? comme par ex : Souhaitez-vous clôturer cette journée ?
Puis si la date existe deja, pouvoir l'enregistrer tout de même (MC 28-08-18 et 28-08-18(1) )
Mes codes :
* fin-service (module 1)
'''MACRO affichage heure quand on valide fin de service
Sub ligne()
ActiveCell.Offset(-0, -1) = Format(Now, "hh:mm")
End Sub
'##########
Sub fin_service()
Dim monClass As Workbook, Chemin As String
Set monClass = ThisWorkbook
Chemin = monClass.Path
Application.EnableEvents = False
[C65536].End(xlUp)(2).Select
ActiveCell = "Journée clôturée" '"Fin de service"
Call ligne
Range("A7").Select
With monClass
Workbooks.Open ("C:\Users\F Leroy\Desktop\ADMINISTRATIF France\DOCUMENTS ENREGISTRES\Main courante\Archives M C.xlsm") 'Chemin & "\Archives M-C.xlsm" 'A ADAPTER !!!!!
.Sheets("MC vierge").Copy after:=Workbooks("Archives M C.xlsm").Sheets(1)
End With
ActiveSheet.Name = "MC du " & Format(Range("C2"), "dd-mm-yy") 'Format(Date, "dd-mm-yy")
'[C4] = Date
ActiveSheet.Protect Password:="1234"
Workbooks("Archives M C.xlsm").Close True
monClass.Sheets("MC vierge").Activate
Range("A1").Select
Application.EnableEvents = True
End Sub
* SaveAsPDF
Sub SaveAsPDF() 'Enregistrement MC Vierge en pdf
Dim FileN$
FileN = Format(Year(Date), "00") & Format(Month(Date), "00") & _
Format(Day(Date), "00") & " " & Format(Time, "hhmmss") & ".pdf"
ChDir "C:\Users\F Leroy\Desktop\ADMINISTRATIF France\Document originale NE PAS TOUCHER\Main-courante"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\F Leroy\Desktop\ADMINISTRATIF France\DOCUMENTS ENREGISTRES\Main courante\M C-pdf\M-C " & FileN, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Main courante enregistrée en PDF", vbInformation, "Enregistrement en PDF"
End Sub
* Mise à l'initial
Sub Reinitialise()
[I2,K2,D5,D8
[B19
[H18] = 5
[C2] = Date
'reste à supprimer les lignes à partir de la 23
End Sub
Soucis que je rencontre également, est que les liens et codes des objets restent et créé des liaisons inutile, serait-il possible de les supprimer à l'enregistrement dans le classeur Archive MC ?
Merci à vous par avance.
Cdlt pompaero
Je joins le classeur de l'onglet à copier.