XL 2016 Copie onglet vers autre classeur

[pompaero]

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,D89,D1213,D1617,B20:C20,M20:N20] = ""
[B1919] = 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.

 

[pompaero]

Re

Je viens de trouver la solution pour la suppression des lignes renseignées afin de remettre à l'initiale. Ca c'est fais
Il reste que le soucis de supprimer les liens et macros l'enregistrement, en simple enregistrer que les valeurs vers Archive MC.

Je joins le classeur avec l'avancée.

 

[ChTi160]

Re
j'ai pu remarquer que l'ensemble des feuilles ont été archivées avec leur Code ;
est ce bien nécessaire ?
Si pas utile , il y a un code de mon ami Dider (MyDearFriend) à adapter !
le Lien : http://www.mdf-xlpages.com/modules/smartfaq/faq.php?faqid=19
Tiens nous au courant.
Bonne fin de Soirée
Amicalement
jean marie

 

[job75]

Re,

Pas mal de choses n'allaient pas, procédons par étape :

1) Dans le fichier "Archives M C.xlsm" supprimez les formules dans toutes les feuilles par Copier-Collage spécial-Valeurs.

Et supprimez les noms définis dans le Gestionnaire de noms.

2) Dans le fichier "Main courante modele.xlsm" Module1 modifier les codes ainsi :

'Affiche les consignes au date correspondantes dans MC Vierge
Function consignes(cel As Range) As String
Dim i&
Application.Volatile
    With ThisWorkbook.Sheets("Consigne")
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If cel >= .Cells(i, 2) And cel <= .Cells(i, 3) Then _
                consignes = consignes & .Cells(i, 4) & " * " '& vbCrLf
        Next i
    End With
End Function

Sub fin_service()
Dim Sh As Worksheet, cel As Range, WbSource As Workbook, nom$, nomdefini As Name, FileN$

If MsgBox("Etes-vous certain de clôturer cette journée ?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False

Set Sh = ThisWorkbook.Sheets("MC Vierge")
Set cel = Sh.Range("B" & Rows.Count).End(xlUp)(2)
 
cel = Format(Now, "hh:mm")
cel.Offset(0, 1) = "Journée clôturée"    '"Fin de service"
Set WbSource = Workbooks.Open(Fichier)
 
Sh.Copy After:=WbSource.Sheets(WbSource.Sheets.Count)
nom = "MC du " & Format(Sh.Range("C2"), "dd-mm-yy") & " " & Format(Time, "hhmm")
      
With ActiveSheet
    .Name = nom
    .[H7] = Sh.[H7]
    .UsedRange = Sh.UsedRange.Value 'supprime les formules
    For Each nomdefini In WbSource.Names
        If nomdefini.Visible Then nomdefini.Delete 'supprime les noms définis visibles
    Next nomdefini
    .Protect Password:="123"
    .Parent.Close True
End With
 
FileN = Format(Date, "dd-mm-yy") & " " & Format(Time, "hhmmss")
Sh.ExportAsFixedFormat xlTypePDF, Filename:=chemin & FileN & ".pdf"
MsgBox "Main courante enregistrée en PDF", vbInformation, "Enregistrement en PDF"

With Sh
    .Range("C2,D5,D8,D9,D12,D13,D16,D17,I2,K2,B20:C20,M20:N20") = "" 'je n'ai pas vérifié...
    .Range("B19:P19") = False
    .Range("H18") = 5
    '.Range("C2") = Date
    Application.Goto .Range("A7")
    .Parent.Save
End With

End Sub

A+

 

[pompaero]

Re job75

Merci de ton aide, elle précieuse.
Je viens te tester tes codes, concernant les consignes, je laisse bien en H7 la formule =consignes(C2) ?
ça a l'air de fonctionner sauf qu'il ne prend pas les consignes correspondant à la date de la main courante en C2. par ex :
MC vierge , la date est le 02 sept 2018 mais cela affiche la consigne du 9 au 11 juillet.
petite interrogation, si il y a plusieurs consignes sur une même date, s'afficheront elles tous ?

ensuite pour la macro fin_service il n'y a plus le message de mise à jour des liaisons, donc ça a l'air de fonctionner.

c'est super on avance doucement mais surement.
A+

 

[pompaero]

Re
j'ai peut être parlé un vite, la macro consigne à l'air de fonctionner finalement, désolé.
Je vais arrêter pour aujourd'hui, je ferai des testes demain à tête reposé.
Merci
bonne soirée
A+

 

[job75]

Re,

MC vierge , la date est le 02 sept 2018 mais cela affiche la consigne du 9 au 11 juillet.

Oui j'ai vu ça, le problème vient du fait que la date du 11 juillet 2018 n'a pas été entrée correctement.

Cette date est en fait du texte, il faut la revalider pour qu'elle devienne une vraie date (nombre).

A+

 

[pompaero]

Bonjour job75

Aah oui !! le réglage se fais au niveau du formulaire consigne j'imagine ? à quel niveau dans le code ?

A+

 

[job75]

Bonjour pompaero, le forum,

Je n'ai rien vu dans le code de l'USF "UF_Consigne_MC" quelque chose qui explique que Consigne!C4 soit du texte.

Revalidez cette cellule manuellement.

A+

 

[pompaero]

Re job75 le fil, le forum,

Effectivement je ne sais pas pourquoi !!!
Du coup j'ai tout effacé les consignes et reparti de zéro, en effet cela fonctionne.
J'ai voulu améliorer le code de manière à ne pas afficher les consignes si la col H feuil "consigne" est non vide, mais bien sur je n'y suis pas arrivé
j'ai tenté ça :

If cel >= .Cells(i, 2) And cel <= .Cells(i, 3) And cel ="" .Cells(i, 8) Then

j'en vois le bout, ça fais plaisir.
A+

 

[ChTi160]

Bonjour pompaero
Le Fil ,le Forum
Je pense que ton probleme vient de cette partie de ton code

And cel=“” .Cells(i,8)

ca ne veut rien dire ,que veux tu tester?
Bonne fin de journee
Jean marie

 

[pompaero]

Bonjour ChTi160; le fil, le forum,

Je veux tester la col H(donc 8) si les cellules sont vide.
la formule ferait
si cel est sup ou égal à Col B et cel est inf ou égal à Col C et Col H ="" alors

'Affiche les consignes au date correspondantes dans MC Vierge
Function consignes(cel As Range) As String
Dim i&
Application.Volatile
    With ThisWorkbook.Sheets("Consigne")
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If cel >= .Cells(i, 2) And cel <= .Cells(i, 3) Then _
                consignes = consignes & .Cells(i, 4) & " * " '& vbCrLf
        Next i
    End With
End Function

Merci
A+
pompaero

 

[ChTi160]

Re
Pas sur d'avoir compris lol
je mettrais donc :

If cel >= .Cells(i, 2) And cel <= .Cells(i, 3) And  .Cells(i, 8)="" Then

jean marie

 

[pompaero]

Re

Super, c'est exactement ça.
Je pense être arrivé au bout de ce fil grasse à vous. Il me reste plus qu'à faire les mise en page afin d'avoir une présentation correct et présenter le sujet à ma direction qui devrait être satisfait du résultat. (mise à part le délai qui est dépassé (oups, c'était pour le 01 sept... pas grave )
Lone-wolf, ChTi160, job75, je vous remercie grandement de votre aide.

A bientot
pompaero.