Discussion :

[Pompaero]

Bonjour

Toujours sur mon projet pour le taf, il me reste quelques détails à affiner, je reviens donc vers vous pour de l'aide.

J'ai un fichier A à remplir lors de la journée et en fin de poste je l'enregistre vers un autre fichier B qui sert d'archives, jusque la ça va.

Sur le fichier A se trouve des boutons avec macro puis quelques formules dans certaines cellules. Sur un des boutons se trouve la macro permettant d'enregistrer (copier/coller) la feuille du fichier A vers le fichier B.
Dans le fichier B j'aimerai avoir le copier/coller de la feuille du fichier A, sans les formules dans les cellules, ni les macros des boutons. Je suis arrivé, a priori à supprimer les formules mais ne trouve pas pour supprimer les macros des boutons, c'est la que j'ai besoin de vous.
Mon code avec quelques explications.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub fin_service()
Dim monClass As Workbook, Chemin As String
 
 '#Message d'alerte avant enregistrement
   If MsgBox("Etes-vous certain de vouloir clôturer cette journée ?", vbYesNo, "Demande de confirmation") = vbYes Then
 
   LgnMasquerFermerUsf  'remise en place des lignes masquées
 
 '#Copie de la feuille vers fichier archive avec protection
    Set monClass = ThisWorkbook
    Chemin = monClass.Path
    Application.EnableEvents = False
    [B65536].End(xlUp)(2).Select
    ActiveCell = "Journée cloturé"
    'Call ligne  'affichage de l'heure en colonne A avec "Journée clôturé"
    Range("J3").Select  'sélection de la cellule
    Export_PDF  'Copie de la feuille en pdf
 With monClass
        Workbooks.Open Chemin & "\Archives M-C.xlsm" '(A ADAPTER !!!!!) chemin pour accéder au fichier voulu
        .Sheets("Main-Courante").Copy after:=Workbooks("Archives M-C.xlsm").Sheets(1) 'Copie feuille vers autre fichier
 '#Suppression des formules
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
      False, Transpose:=False
    Application.CutCopyMode = False
    Cells(3, 10).Select
 End With
 '## PREVOIR MSG BOX AFIN DE CONTROLER SI L'ONGLET EXISTE DEJA
    ActiveSheet.Name = Format(Now, "dd-mm-yy hh""h""nn") '(Date, "dd-mm-yy hh:mm") 'nomination de l'onglet avec la date
    [C4] = Date
    ActiveSheet.Protect Password:="1234"  'protection de la feuille
    'Prévoir pour masquer les onglets !!!!!!!!!!!!!!
    Workbooks("Archives M-C.xlsm").Close True 'fermeture du fichier apres copie
 '#Retour vers la main courante en mode initiale
    monClass.Sheets("Main-courante").Activate  'apparition de nouveau de la main courante
    Suppr_Lignes  'initialisation du nombre de lignes
    [A8:E19,G4:H4,F8:H10,A22:J29,A31:J38].ClearContents  'remet toutes les cellules vide
    [F12:F13,H12:H13,F15:F19,H15:H19] = False
    Réajusligne  'réajuste la hauteur des lignes
    Application.EnableEvents = True
    End If
    MsgBox "Nouvelle main courante prête à l'utilisation", vbExclamation, "Nouvelle main courante"
End Sub

J'espère que mes explications seront compréhensible, si non demandez moi plus de détails, ou fichiers.
Merci à vous

[joe.levrai]

Bonjour,

cet exemple rapide boucle sur l'ensemble des Formes de la plage active, et pour ceux pouvant être dotés d'une macro (via la propriété OnAction), on la supprime

à totalement adapter et sécuriser

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub test()
Dim Ct As Shape
    For Each Ct In ActiveSheet.Shapes
        On Error Resume Next
            Ct.OnAction = ""
        On Error GoTo 0
    Next Ct
End Sub

[Pompaero]

Bonjour joe.levrai

Merci de ton aide
Je viens de tester ta proposition, C'EST !!! juste parfais.. .

C'est exactement ce que je voulais, grasse à toi j'avance à vitesse grand V sur mon fichier.

Grand merci encore.