Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2016 Copie onglet vers autre classeur

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,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.
 

Pièces jointes

  • Main courante modele.xlsm
    152.7 KB · Affichages: 35

pompaero

XLDnaute Impliqué
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.
 

Pièces jointes

  • Main courante modele.xlsm
    147.3 KB · Affichages: 26

job75

XLDnaute Barbatruc
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 :
Code:
'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
Code:
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

XLDnaute Impliqué
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

XLDnaute Impliqué
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 :
Code:
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

XLDnaute Barbatruc
Bonjour pompaero
Le Fil ,le Forum
Je pense que ton probleme vient de cette partie de ton code
VB:
And cel=“” .Cells(i,8)
ca ne veut rien dire ,que veux tu tester?
Bonne fin de journee
Jean marie
 

pompaero

XLDnaute Impliqué
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
Code:
'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
 

pompaero

XLDnaute Impliqué
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.
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…