suppression de tout les modules, userform, et workbook etc..

Pascalebureau

XLDnaute Nouveau
Bonjour,


J'ai réaliser un fichier, avec différent modules et macro .

Le probleme c'est que dois supprimer toutes ces macro une par une des que j'envoie mon fichier ....

Auriez vous m'aimabilité de m'aider merci ....
 

Pièces jointes

  • essai.xlsm
    181.5 KB · Affichages: 41
  • essai.xlsm
    181.5 KB · Affichages: 44
  • essai.xlsm
    181.5 KB · Affichages: 46

CHALET53

XLDnaute Barbatruc
Re : suppression de tout les modules, userform, et workbook etc..

Bonjour Pascal et Pierrot

Ok avec Pierrot ou si tu veux du code : A adapter

Sub supprimerUnModule()
With ThisWorkbook.VBProject.VBComponents
.Remove .Item("Module2")
End With
With ThisWorkbook.VBProject.VBComponents
.Remove .Item("Userform2")
End With
End Sub


a+
 

Herdet

Nous a quitté
Repose en paix
Re : suppression de tout les modules, userform, et workbook etc..

Bonjour,
J'ai réaliser un fichier, avec différent modules et macro .
Le probleme c'est que dois supprimer toutes ces macro une par une des que j'envoie mon fichier ....
Auriez vous m'aimabilité de m'aider merci ....
Bonjour,
Voiçi un code VBA à adapter à ton fichier récupéré sur le site de codes VBA de Frédéric Sigonneau
Site : Ce site n'existe plus
Rubrique : "Editeur de code, modules, projets"
Procédure : DetruireToutCodeSaufMoi.bas
Cordialement
Robert

Code:
'détruire tout le code d'un classeur, sauf la procédure qui procède à cette destruction

Sub ToutDetruireSaufMoi()
Dim AGarder$, MonModule$, LiDeb, LiFin, Tmp$

  AGarder = "ToutDetruireSaufMoi"
  MonModule = "Module1" 'ou autre

  'récupérer le texte de cette macro
  With ThisWorkbook.VBProject.VBComponents(MonModule).CodeModule
    LiDeb = .ProcStartLine(AGarder, 0)
    LiFin = .ProcCountLines(AGarder, 0)
    Tmp = .Lines(LiDeb, LiFin)
  End With

Dim VbComp, LesComps
  'détruire tout le code de ce classeur
  Set LesComps = ThisWorkbook.VBProject.VBComponents
  For Each VbComp In LesComps
    Select Case VbComp.Type
      Case 1, 2, 3
        If VbComp.Name = MonModule Then
          With VbComp.CodeModule
            .DeleteLines 1, .CountOfLines
            'mais conserver cette macro
            .AddFromString Tmp
          End With
        Else: LesComps.Remove VbComp
        End If
      Case 100
        VbComp.CodeModule.DeleteLines 1, VbComp.CodeModule.CountOfLines
    End Select
  Next

End Sub
 

Staple1600

XLDnaute Barbatruc
Re : suppression de tout les modules, userform, et workbook etc..

Bonjour à tous

Pourquoi se compliquer la vie ? (avec du code VBA dédié à supprimer du code VBA)
La solution la plus simple (et la plus rapide) est celle suggérée par Pierrot93 hier à 16h56, non ?

A la rigueur, on peut passer par VBA pour enregistrer en *.xlsx puis envoi de cet *.xlsx par mail.
(puisque c'est ce que semble vouloir Pascalebureau)
(En mettant ce code dans le classeur de macros personnelles)

On peut aussi envisager un enregistrement en PDF si on veut une copie figée du classeur à envoyer par mail.
 
Dernière édition:

Roland_M

XLDnaute Barbatruc
Re : suppression de tout les modules, userform, et workbook etc..

bonjour à tous,

Je vous propose ce petit utilitaire que je me suis concocté.
Avec un grand merci à Mr Ron De Bruin !
 

Pièces jointes

  • _PERSO VBA_ImportExport.xlsm
    63.8 KB · Affichages: 53
Dernière édition:

Pascalebureau

XLDnaute Nouveau
Re : suppression de tout les modules, userform, et workbook etc..

Bonjour,

J'ai un userfom qui s'affiche a l'ouverture de mon fichier. sauf qu'une fois enregistré en xls. il n'a plus lieu de s'ouvrir.

Je souhaiterais vraiment supprimer mes macro d'une pour allèger le fichier et de deux pour simplifier l'ouverture.

merci a vous tous pour vos réponses.
 

Roland_M

XLDnaute Barbatruc
Re : suppression de tout les modules, userform, et workbook etc..

bonjour,

franchement c'est pas clair ton affaire !
tu enregistres au format sans macro "xlsx"
et puis c'est tout !

EDIT: le format xls c'est 97-2003 et avec macro !

voilà ton classeur nettoyé, même au format xlsm !
et le même enregistré sous xlsx !
 

Pièces jointes

  • essai.xlsm
    19.9 KB · Affichages: 34
  • essai.xlsm
    19.9 KB · Affichages: 33
  • essai.xlsm
    19.9 KB · Affichages: 34
  • essai.xlsx
    20 KB · Affichages: 27
  • essai.xlsx
    20 KB · Affichages: 28
  • essai.xlsx
    20 KB · Affichages: 31
Dernière édition:

Pascalebureau

XLDnaute Nouveau
Re : suppression de tout les modules, userform, et workbook etc..

bonjour

J'ai un UF qui se lance a l'ouverture du fichier meme quand j'enregistre au format sans macro .xls. Donc vous me dites tous que c'est super facile, mais moi je n'y arrives, donc merci de prendre le temps de m'expliquez comment faire ? je suis sous excel 2007 et/ou excel 2013. De plus j'envoie mes fichier par mail et leur serveur bloque la reception qd une piece jointe fait plus de 1Mo (je sais c'est peénible) donc je dois purger les UF et tout les tableau d'aide a la création de mon fichier. Voilà pourquoi je veux absolument que mes UF et macro en woorkbook soit supprimées .

Second petit probleme
Je dois convertir mes fichier sous format excel97 car mon client ne dispose que d'excel 97. il ne peux pas lire les tableaux croisées dynamiques, donc je dois copier/coller les valeurs .Auriez vous une astuce pour que lors que j'enregistre sous ce tableau se "transforme" en valeur?
 

MJ13

XLDnaute Barbatruc
Re : suppression de tout les modules, userform, et workbook etc..

Re

Pour copier ton tableau en valeur, tu peux tester ceci:

Code:
Sub Copie_Structure_Feuille_Valeur_Format_Commentaire()
'Dim t1 As Long, NomFAct As String, DerCelSel As Variant, DerCelAdr As Variant, NBcol As Long, NBLig As Long, cell As Range, i As Long
    Dim LargCol(1048576), HautLig(1048576)    ', DercelLig As Long, DerCelCol As Long, Ilig As Long, ICOl As Long
 If [A1].SpecialCells(xlLastCell).Address = "$A$1" And [A1] = "" Then Exit Sub
    t1 = Timer
    Application.ScreenUpdating = False
    NomFAct = ActiveSheet.Name

    'DerCelSel = ActiveCell.SpecialCells(xlLastCell).Select
    'DerCelAdr = ActiveCell.Address
    'DercelCol = ActiveCell.Column
    'DercelLig = ActiveCell.Row
    'Attenton si bug avec des feuille vide mais à la fin à 1 milllions de ligne.Voir avec les paramètres suivant:
    
   'If DercelLig > 1000 Then DercelLig = 65000
   'If DercelCol > 1000 Then DercelCol = 65000
   'MsgBox Cells.Find("*", [A1], , , 1, 2).Row
   DercelLig = Cells.Find("*", [A1], , , 1, 2).Row
   DercelCol = Cells.Find("*", [A1], , , 1, 2).Column
   
    NBcol = 0
    For ICOl = 1 To DercelCol
        If Cells(1, ICOl).ColumnWidth <> 0 Then NBcol = NBcol + 1: LargCol(NBcol) = Cells(1, ICOl).ColumnWidth
    Next
    
    
    NBLig = 0
    For Ilig = 1 To DercelLig
        If Rows(Ilig & ":" & Ilig).RowHeight <> 0 Then NBLig = NBLig + 1: HautLig(NBLig) = ActiveSheet.Rows(Ilig & ":" & Ilig).RowHeight
    Next
    'Stop
    ' A voir pour traitement de type Tableau
    'For Each cell In ActiveSheet.Range(Cells(1, 1), Cells(DercelLig, DerCelCol))
        'Traitement tableau
    'Next
    Sheets.Add
    For i = 1 To NBcol
        Cells(1, i).ColumnWidth = LargCol(i)
    Next
    For i = 1 To NBLig
        Rows(i & ":" & i).RowHeight = HautLig(i)
    Next
    ActiveSheet.Next.Select
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Copy
    ActiveSheet.Previous.Select
    Range("A1").Select
    
    'Mettre pour chaque cellule la valeur et le format et le commentaire
    'Posibilité de mettre la formule avec xlPasteFormulas mais commenter xlPasteValues
    'Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=False
     
     'Copie la valeur
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
     'Copie le Format
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
    'Copie les Commentaires
    Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
                            SkipBlanks:=False, Transpose:=False
                           On Error Resume Next 'au cas ou le nom de l'onglet existe
        If Len(NomFAct) < 27 Then ActiveSheet.Name = "CV " & Replace(NomFAct, " ", "") Else ActiveSheet.Name = "CV " & Replace(Mid(NomFAct, 1, 14), " ", "") & Replace(Right(NomFAct, 14), " ", "")
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

    'MsgBox Timer - t1
    Application.StatusBar = Format(Timer - t1, "0.0") & " secondes"
End Sub
 

Staple1600

XLDnaute Barbatruc
Re : suppression de tout les modules, userform, et workbook etc..

bonsoir à tous

Il y a plus simple pour un copier/valeurs seules en VBA
(ici on traite la feuille active)

Code:
Sub cvalseul()
With ActiveSheet
    .UsedRange.Value = .UsedRange.Value
End With
End Sub

Sinon lire ceci pour savoir comment enregistrer en *.xlsx

Donc ensuite faire ceci dans l'ordre
Lancer la macro cvalseul
Enregistrer en *.xlsx
Fermer Excel
Ouvrir le fichier *.xlsx et l'enregistrer en *.xls
Tu auras alors un fichier *.xls sans macros et avec des valeurs seules.
 

MJ13

XLDnaute Barbatruc
Re : suppression de tout les modules, userform, et workbook etc..

Bonjour à tous


Jean-Marie: pas sur que ton code copie la structure de la feuille :confused:.

Mon code le fait et ne bug pas dans certains cas que j'ai souvent expérimenté :). Ce code, je m'en sers tout le temps et il est unique :D.
 

Discussions similaires

Statistiques des forums

Discussions
312 305
Messages
2 087 093
Membres
103 467
dernier inscrit
Pandiska