VBA Exporter et importer code ThisWorkbook

[Arpette]

Bonsoir à toutes et à tous, voilà mon problème.
J'ai un code écrit dans ThisWorkbook. On m'a demandé de mettre un message, j'ai modifié pas de problème.
Maintenant, on me demande de dupliquer ce code sur tous les fichiers. Tous ces fichiers sont stockés dans le même dossier, mais il y en des centaines.
Y a-t-il un moyen de modifier dans un, comme je l'ai fait et renvoyer la modification vers tous tous les autres classeurs
Merci de votre aide
@+
Ancien code

Private Sub workbook_open()
 Dim DateDepart As Date
 Dim J As Integer
 Dim m As String
 Dim Number As Integer
    J = Format(Date, "d", today)
    Sheets("Page 1").Select
    Cells(45, 9) = Format(Date, "dd-mmmm-yyyy")
    DateDepart = DateSerial(Year(Date), Month(Date) + 12, J)
    Cells(46, 23) = Format(DateDepart, "dd-mmmm-yyyy")
    Sheets("Page 1").Select
    Cells(35, 11).Select
End Sub

Nouveau code

Private Sub workbook_open()
 Dim DateDepart As Date
 Dim J As Integer
 Dim m As String
 Dim Number As Integer
 Dim bx As Long
    bx = MsgBox("Veux-tu changer la date", vbYesNo)
    If (bx = 6) Then
        Else
        Exit Sub
    End If
    J = Format(Date, "d", today)
    Cells(45, 9) = Format(Date, "dd-mmmm-yyyy")
    DateDepart = DateSerial(Year(Date), Month(Date) + 12, J)
    Cells(46, 23) = Format(DateDepart, "dd-mmmm-yyyy")
    Sheets("Page 1").Select
    Cells(35, 11).Select
End Sub

 

[klin89]

Re : VBA Exporter et importer code ThisWorkbook

Bonsoir le forum,
Bonsoir Arpette

Une recherche sur le forum s'impose :
Dans Google :

site:excel-downloads.com VBComponents +export

Klin89

 

[Arpette]

Re : VBA Exporter et importer code ThisWorkbook

Bonjour Klin à Tous, j'ai trouvé un code que j'ai adapté à ThisWorkbook. J'ai deux problèmes
1. Il faudrait, remplacer ThisWorkbook du classeur de destination et pas créé de copie
2. Il faudrait que le code s'applique à tous les classeurs du dossier "Tames"
Merci de votre aide
@+

Sub Export_Import_ThisWorkbook()
Dim Wb As Workbook
Dim i As Byte
'-----------------------------------
'Export ThisWorbook
ThisWorkbook.VBProject.VBComponents("ThisWorkbook").Export _
    "j:\ThisWorkbook" & ".bas"

'-----------------------------------

'Ouverture du Classeur d'import
Set Wb = Workbooks.Open("j:\Trames\BENNE ORDURES MENAGERES.xls")
'la procedure ne gère pas les erreurs si le nom des modules
'existe deja dans le classeur d'import.
With Wb.VBProject 'transfert ThisWorkbook
    .VBComponents.Import "j:\ThisWorkbook" & ".bas"
  
End With
'Ferme le classeur d'import en sauvegardant les modifs
Wb.Close True
End Sub

 

[kjin]

Re : VBA Exporter et importer code ThisWorkbook

Bonjour,
Peut-être à tester au préalable sur des fichiers bidons pour vérifier que ça correspond bien avant de lancer à grande échelle...
Attention traite tous les fichiers .xls du répertoire sauf le classeur actif s'il s'y trouve
Ne pas oublier d'activer la bibliothèque spécifiée

'Activer MS VBA Extensibitity x.x au préalable
Sub zyva()
Dim nf%, fbas$, f$
Dim wb As Workbook
Dim VBProj As VBIDE.VBProject, CodeMod As VBIDE.CodeModule
Dim i&

Rep = "J:\Trames\"
fbas = Rep & "ModuleArpette.bas"
If Dir(fbas) <> "" Then Kill fbas

nf = FreeFile 'crée le fichier .bas
Open fbas For Output Access Write As #nf
Print #nf, "Attribute VB_Name = ""NewModule"""
Print #nf, "Sub Demarrer()"
Print #nf, "Dim DateDepart As Date"
Print #nf, "Dim J%, m$, Number%, bx&"
Print #nf, "If MsgBox(""Veux-tu changer la date"", vbYesNo)=vbNo then exit sub"
Print #nf, "J = VBA.Day(VBA.Date)"
Print #nf, "ActiveSheet.Cells(45, 9) = Format(Date, ""dd-mmmm-yyyy"")"
Print #nf, "DateDepart = DateSerial(Year(Date), Month(Date) + 12, J)"
Print #nf, "ActiveSheet.Cells(46, 23) = Format(DateDepart, ""dd-mmmm-yyyy"")"
Print #nf, "Sheets(""Page 1"").Select"
Print #nf, "Cells(35, 11).Select"
Print #nf, "End Sub"
Close nf

Application.ScreenUpdating = False
Application.EnableEvents = False

f = Dir(Rep & "*.xls")
Do While f <> "" 'boucle sur les fichiers du répertoire
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(Rep & f)
        Set VBProj = wb.VBProject
        With VBProj
            .VBComponents.Import fbas 'importe le fichier .bas dans un module standard
            Set CodeMod = VBProj.VBComponents("ThisWorkbook").CodeModule
            With CodeMod
                .DeleteLines 1, .CountOfLines 'supprime les lignes dans thisworkbook
                i = .CreateEventProc("Open", "Workbook")
                .InsertLines i + 1, "Demarrer" 'ajoute la procédure dans thisworkbook
            End With
            On Error GoTo 0
            Set VBProj = Nothing
            Set CodeMod = Nothing
        End With
        wb.Close True
    End If
    f = Dir()
Loop

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

A+
kjin

 

[Arpette]

Re : VBA Exporter et importer code ThisWorkbook

Bonjour Kjin, merci pour ta réponse. J'ai deux questions, où je place le code, dans un module du classeur modifié, dans ThisWorkbook du classeur ou dans un autre classeur. Ma deuxième question, je ne trouve pas où 'Activer MS VBA Extensibitity".
Merci de ton aide
@+

 

[kjin]

Re : VBA Exporter et importer code ThisWorkbook

Re,

où je place le code, dans un module

à mettre dans un module standard d'un classeur temporaire que tu pourras jeté ensuite et sur lequel tu auras mis un joli bouton
Penses à refermer tous les classeurs actifs (sauf le classeur temporaire évidemment...😀)

je ne trouve pas où 'Activer MS VBA Extensibility".

dans le menu de VBE, Outils/Références, coches la bibliothèque Microsoft Visual Basic For Application Extensibility x.x
Penses à faire une copie de sauvegarde de tes fichiers...
A+
kjin

 

[Arpette]

Re : VBA Exporter et importer code ThisWorkbook

Bonjour Kjin, j'ai cette erreur :"Erreur d'entrée/sortie de périphérique"

 Set wb = Workbooks.Open(Rep & f)

Merci de ton aide
@+