英文:
Copy update module from Personal.xlsb workbook to activeworkbook
问题
I have a module in personal.xlsb workbook that has 15+ sub procedures with 20,000+ lines of code to upgrade my quoting spreadsheet to the latest version of changes. When it is done running I need to copy over existing modules or delete modules and import the updated modules for the updates to run correctly. Any help is appreciated.
I have searched for answers but have not got anything to run.
英文:
I have a module in personal.xlsb workbook that has 15+ sub procedures with 20,000+ lines of code to upgrade my quoting spreadsheet to the latest version of changes.
when it is done running I need to copy over existing modules or delete modules and import the updated modules for the updates to run correctly.
any help is appreciated.
i have searched for answers but have not got anything to run.
答案1
得分: 1
I have translated the provided text into English. Please note that some parts of the text contain code or technical information that may not translate perfectly:
Good morning,
You can take inspiration from the code of the attached procedures, which are part of a module I created for an application. The object of the procedures of this module is precisely the manipulation of the modules (deletion, import, etc.). The procedures are part of an XLAM or XLSM workbook and run for the ActiveWorkbook.
There is a lot of code, but you will probably find your happiness there.
PS. The comments are in French.
Good luck
Sub import_all_modules_from_backup()
'Imports and replaces modules from the backup folder
ActiveWorkbook.Activate
' * Call search and activate if not already installed
If Not ReferenceActive("C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB", ThisWorkbook) Then
ActiveWorkbook.VBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End If
'Determine the "File Name" variable used in calculating module file paths
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")), "_", "")
'Redefine Source for cycle workbook, ExamProcedure, or Analysis_Sales or purchases
If InStr(source, "Cycles01") > 0 Then
source = "Cycles01"
ElseIf InStr(source, "Cycle") > 0 Then
source = "Cycle_B01"
ElseIf InStr(source, "ExamenP") > 0 Then
source = "Examen_Procedures_01"
ElseIf InStr(source, "AnalysedesVentes0") > 0 Then
source = "Analyse_des_Ventes_01"
ElseIf InStr(source, "AnalysedesTVAREC0") > 0 Then
source = "Analyse_des_TVA_REC_01"
Else
'Remove spaces for VBA module names
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")), " ", "")
End If
'Test if the VBA source folder exists
' * Path to import modules, user's desktop + the constant range("Path_VBA").Value + "BAS_New\" + file name without extension + CLs folder
With ActiveWorkbook
repert = Range("Path_VBA").Value & "BAS_New\" & source & "\"
End With
' * Check if it exists
' * Create a backup folder if it doesn't exist
If Not Dir(repert, vbDirectory) <> vbNullString And Not Dir(repert & "Sauve\*.bas") <> vbNullString Then
MsgBox "Update is impossible, VBA module path does not exist", vbExclamation
GoTo exit_
End If
delete_all_modules 'Delete all modules in the workbook
Import_Module_from_save 'Import type 1 bas modules
Import_Cls_Wb_sh_from_cls 'Import type 1 bas modules
Import_Frm_from_frm
Ren_Mod_End_1 'Rename imported modules that are duplicates
exit_:
End Sub
Sub Update_Development_Modules()
'Imports modules from the development folder
ActiveWorkbook.Activate
' * Call search and activate if not already installed
If Not ReferenceActive("C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB", ThisWorkbook) Then
ActiveWorkbook.VBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End If
Update_Module_From_New
Update_frm_from_new
End Sub
Sub Import_Module_from_save(Optional shdw As Boolean)
Dim VBProj As VBIDE.VBProject
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")), "_", "")
'Redefine Source for cycle workbook, ExamProcedure, or Analysis_Sales or purchases
If InStr(source, "Cycles01") > 0 Then
source = "Cycles01"
ElseIf InStr(source, "Cycle") > 0 Then
source = "Cycle_B01"
ElseIf InStr(source, "ExamenP") > 0 Then
source = "Examen_Procedures_01"
ElseIf InStr(source, "AnalysedesVentes0") > 0 Then
source = "Analyse_des_Ventes_01"
ElseIf InStr(source, "AnalysedesTVAREC0") > 0 Then
source = "Analyse_des_TVA_REC_01"
Else
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".")), " ", "")
End If
Set VBProj = ActiveWorkbook.VBProject
' * Determine the "File Name" variable used in calculating module file paths
source = Replace(Left(Active
<details>
<summary>英文:</summary>
Good morning,
You can take inspiration from the code of the attached procedures, which are part of a module I created for an application. The object of the procedures of this module is precisely the manipulation of the modules (deletion, import, etc.). the procedures are part of an XLAM or XLSM workbook, and run for the Activeworkbook.
There is a lot of code, but you will probably find your happiness there.
There is a lot of code, but you will probably find your happiness there.
PS. The comments are in French.
Good luck
Sub importe_tout_modules_depuis_sauve()
'importe et remplace les modules depuis le dossier de sauvegarde
ActiveWorkbook.Activate
'*Appel recherche et active si non, si non install
If Not ReferenceActive("C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB", ThisWorkbook) Then
ActiveWorkbook.VBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End If
'*determine la variable "Nom de fichier" utilisée dans le calcul du chemin des fichiers modules
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), "_", "")
'redefinit Source si classeur de cycle, ou ExamProcedure, ou Analyse_Ventes ou achats
If InStr(1, source, "Cycles01") > 0 Then
source = "Cycles01"
ElseIf InStr(1, source, "Cycle") > 0 Then
source = "Cycle_B01"
ElseIf InStr(1, source, "ExamenP") > 0 Then
source = "Examen_Procedures_01"
ElseIf InStr(1, source, "AnalysedesVentes0") > 0 Then
source = "Analyse_des_Ventes_01"
ElseIf InStr(1, source, "AnalysedesTVAREC0") > 0 Then
source = "Analyse_des_TVA_REC_01"
Else
'supprime les espaces pour le nom des modules VBA
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), " ", "")
End If
'test si le dossier des sources vba existe
'*le chemin des modules à importer, bureau de l'utilisateur + la constante range("Path_VBA").Value & "BAS_New\" + le nom de ce fichier sans l'extension + dossier CLs
With ActiveWorkbook
repert = Range("Path_VBA").Value & "BAS_New\" & source & "\"
End With
'*et vérifie qu'il existe
'*et crée un dossier de sauvegarde si il n'existe pas
'*et vérifie qu'il existe
'*et crée un dossier de sauvegarde si il n'existe pas
If Not Dir(repert, vbDirectory) <> vbNullString And Not Dir(repert & "Sauve\*.bas") <> vbNullString Then
MsgBox "la mise à jour est impossible, le chemin des modules vba est inexistant", vbExclamation
GoTo exit_
End If
supprime_tous_les_modules 'supprime tous les modules du classeur
Import_Module_depuis_save 'importe les modules e type 1 bas
Import_Cls_Wb_sh_depuis_cls 'importe les modules e type 1 bas
Import_Frm_depuis_frm
Ren_Mod_End_1 'renomme les modules importés en doublon
'renomme_modules1
exit_:
End Sub
Sub Maj_Modules_Developpement_ext() 'Optional shdw As Boolean)
'importe les modules depuis le dossier de développement
ActiveWorkbook.Activate
'*Appel recherche et active si non, si non install
If Not ReferenceActive("C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB", ThisWorkbook) Then
ActiveWorkbook.VBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End If
Maj_Module_From_New
Maj_frm_from_new
'renomme_modules1
End Sub
Sub Import_Module_depuis_save(Optional shdw As Boolean)
Dim VBProj As VBIDE.VBProject
' Dim VBComp As VBIDE.VBComponent
' Dim CodeMod As VBIDE.CodeModule
Dim StartLine As Long
Dim NumLines As Long
'Dim ProcName As String
Dim repert As String
Dim Module As Variant
Dim nom_module As String
Dim fichier As String
Dim module_import As Variant
'*definition au niveau procédure des variable de type optionnal supprimées en tant que paramètre
'Dim nom_projet As String
Set VBProj = ActiveWorkbook.VBProject
'*determine la variable "Nom de fichier" utilisée dans le calcul du chemin des fichiers modules
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), "_", "")
'redefinit Source si classeur de cycle, ou ExamProcedure, ou Analyse_Ventes ou achats
If InStr(1, source, "Cycles01") > 0 Then
source = "Cycles01"
ElseIf InStr(1, source, "Cycle") > 0 Then
source = "Cycle_B01"
ElseIf InStr(1, source, "ExamenP") > 0 Then
source = "Examen_Procedures_01"
ElseIf InStr(1, source, "AnalysedesVentes0") > 0 Then
source = "Analyse_des_Ventes_01"
ElseIf InStr(1, source, "AnalysedesTVAREC0") > 0 Then
source = "Analyse_des_TVA_REC_01"
Else
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), " ", "")
End If
'*Définit le classeur de destination (qui doit être préalablement ouvert).
Set wb = ActiveWorkbook
' '*Nomme le projet du classeur actuel au soit fecxtools + nom du fichier sans l'extension ex: Fecxtools_Cycle_X
'*le chemin des modules à importer, bureau de l'utilisateur + la constante range("Path_VBA").Value & "BAS_New\" + le nom de ce fichier sans l'extension + dossier CLs
repert = Range("Path_VBA").Value & "BAS_New\" & source & "\"
'*et vérifie qu'il existe
'*et crée un dossier de sauvegarde si il n'existe pas
'*et vérifie qu'il existe
'*et crée un dossier de sauvegarde si il n'existe pas
If Not Dir(repert, vbDirectory) <> vbNullString Then
MsgBox "le dossier n'existe pas", vbExclamation
GoTo exit_
End If
'*nb_module = Application.VBE.VBProjects(nom_projet).VBComponents.Count
fichier = Dir(repert & "Sauve\*.bas")
While fichier <> ""
Debug.Print fichier
nom_module = (Left(fichier, InStrRev(fichier, ".") - 1))
'If Not (UCase(nom_module) = UCase(ControleProcedureActiveDEV)) Then
'importe tous les modules présents
If VerifierExistenceModule(nom_module) = True Then
If ActiveWorkbook.VBProject.VBComponents(nom_module).Type = 1 Then
Set Module = ActiveWorkbook.VBProject.VBComponents(nom_module)
ActiveWorkbook.VBProject.VBComponents.Remove (Module)
Set module_import = ActiveWorkbook.VBProject.VBComponents.Import(repert & "Sauve\" & fichier)
'Debug.Print fichier
End If
Else ''If propose = True Then ' en pause
'If MsgBox("voulez-vous importer ce nouveau module " & Chr(13) & nom_module, vbYesNo) = 6 Then
Set module_import = ActiveWorkbook.VBProject.VBComponents.Import(repert & "Sauve\" & fichier)
Debug.Print fichier
'End If
'End If
End If
fichier = Dir
Wend
exit_:
End Sub
Sub Maj_Module_From_New()
'recupere et remplace les modules depuis
'C:\Users\phm\Desktop\DEV\BAS_New\A_New_Communs
Dim VBProj As VBIDE.VBProject
' Dim VBComp As VBIDE.VBComponent
' Dim CodeMod As VBIDE.CodeModule
Dim StartLine As Long
Dim NumLines As Long
'Dim ProcName As String
Dim repert As String
Dim Module As Variant
Dim nom_module As String
Dim fichier As String
Dim module_import As Variant
'*definition au niveau procédure des variable de type optionnal supprimées en tant que paramètre
'Dim nom_projet As String
Dim propose As Boolean
Set VBProj = ActiveWorkbook.VBProject
repert = Range("Path_VBA").Value & "BAS_New\A_New_Communs\" '& "New\"
'*et vérifie qu'il existe
'*et crée un dossier de sauvegarde si il n'existe pas
If Not Dir(repert, vbDirectory) <> vbNullString Then
MsgBox "le dossier n'existe pas ou est vide", vbExclamation
GoTo exit_
End If
'*demande si on doit proposer d'installer les nouveaux modules
If MsgBox("proposition de nx modules", vbYesNo) = 6 Then propose = True
'*nb_module = Application.VBE.VBProjects(nom_projet).VBComponents.Count
fichier = Dir(repert & "\*.bas")
While fichier <> ""
nom_module = (Left(fichier, InStrRev(fichier, ".") - 1))
'Debug.Print nom_module
'If Left(nom_module, 5) = "A_Exp" Then Stop
'If Not (UCase(nom_module) = UCase(ControleProcedureActiveDEV)) Then
If VerifierExistenceModule(nom_module) = True Then
If ActiveWorkbook.VBProject.VBComponents(nom_module).Type = 1 Then
'If Left(Fichier, 1) = "X" Then Stop
Debug.Print fichier
Set Module = ActiveWorkbook.VBProject.VBComponents(nom_module)
ActiveWorkbook.VBProject.VBComponents.Remove (Module)
Set module_import = ActiveWorkbook.VBProject.VBComponents.Import(repert & fichier)
End If
ElseIf propose = True Then ' en pause
If MsgBox("voulez-vous importer ce nouveau module " & Chr(13) & nom_module, vbYesNo) = 6 Then
Set module_import = ActiveWorkbook.VBProject.VBComponents.Import(repert & "\" & fichier)
Debug.Print fichier
End If
End If
'End If
'End If
' 'pour une procedure spécifique dans le module
' ProcName = "NomProcedure"
'
' With CodeMod
' 'VBProj.VBComponents("Module2")'
' '.ProcName.Delete
' StartLine = .ProcStartLine(ProcName, vbext_pk_Proc)
' NumLines = .ProcCountLines(ProcName, vbext_pk_Proc)
' .DeleteLines StartLine:=StartLine, Count:=NumLines
' End With
fichier = Dir
Wend
exit_:
End Sub
'*************************************************************************************'
'*Importe le code des feuilles et workbook
'*
'*
'*
'*
'*************************************************************************************'
Sub Import_Cls_Wb_sh_depuis_cls(Optional shdw As Boolean)
'* importe les fichier BAS correspondant aux macors de feuilles ou workbook, depuis
'* le dossier
'* C:\Users\phm\Desktop\DEV\BAS_New\PMSYNTHESE\Cls
'*Nécessite d'activer la référence "Microsoft Visual Basic for Applications Extensibility 5.3"
Dim wb As Workbook
Dim oModule As CodeModule
Dim VBComp As VBComponent
Dim x As Integer
Dim cible As String
Dim source As String
Dim repert As String
Dim nom_projet As Variant
Dim nom_module As String
Dim fichier As String
'*determine la variable utilisée dans le calcul du chemin des fichiers modules
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), "_", "")
'redefinit Source si classeur de cycle
'redefinit Source si classeur de cycle, ou ExamProcedure, ou Analyse_Ventes ou achats
If InStr(1, source, "Cycles01") > 0 Then
source = "Cycles01"
ElseIf InStr(1, source, "Cycle") > 0 Then
source = "Cycle_B01"
ElseIf InStr(1, source, "ExamenP") > 0 Then
source = "Examen_Procedures_01"
ElseIf InStr(1, source, "AnalysedesVentes0") > 0 Then
source = "Analyse_des_Ventes_01"
ElseIf InStr(1, source, "AnalysedesTVAREC0") > 0 Then
source = "Analyse_des_TVA_REC_01"
Else
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), " ", "")
End If
'*Définit le classeur de destination (qui doit être préalablement ouvert).
Set wb = ActiveWorkbook 'Workbooks("CibleThisWB.xlsx")
' '*Nomme le projet du classeur actuel au soit fecxtools + nom du fichier sans l'extension ex: Fecxtools_Cycle_X
' Application.VBE.ActiveVBProject.Name = "fecxtools_" & Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), " ", "")
' nom_projet = Application.VBE.ActiveVBProject.Name
'*le chemin des modules à importer, bureau de l'utilisateur + la constante range("Path_VBA") & "BAS_New\" + le nom de ce fichier sans l'extension + dossier CLs
repert = Range("Path_VBA").Value & "BAS_New\" & source & "\" '& "\New"
'*et vérifie qu'il existe
'*et crée un dossier de sauvegarde si il n'existe pas
If Not Dir(repert, vbDirectory) <> vbNullString Then
MsgBox "le dossier n'existe pas", vbExclamation
GoTo exit_
End If
'*nb_module = Application.VBE.VBProjects(nom_projet).VBComponents.Count
fichier = Dir(repert & "CLS\*.cls")
While fichier <> ""
'*Set wb = Workbooks.Open(Fichier)
nom_module = (Left(fichier, InStrRev(fichier, ".") - 1))
'If Not (UCase(nom_module) = UCase(ControleProcedureActiveDEV)) Then
If VerifierExistenceModule(nom_module) = True Then
If ActiveWorkbook.VBProject.VBComponents(nom_module).Type = 100 Then
'*défini le module à importer, et l'importe (en tant que module de classe)
Set VBComp = wb.VBProject.VBComponents.Import(repert & "CLS\" & fichier)
'*Le renomme (pour le supprimer plus facilement ultérieurement, il va aller dans modules de classe
cible = "Temp"
VBComp.Name = cible
Set oModule = VBComp.CodeModule
'*Transfère les données chargées dans le module de classe activeworkbook.
'*Attention les données existantes dans "activeworkbook" sont écrasées.
With wb.VBProject.VBComponents(nom_module).CodeModule
x = .CountOfLines
.DeleteLines 1, x
.InsertLines 1, oModule.Lines(1, oModule.CountOfLines)
End With
'*Suppression du module ancien
With wb.VBProject.VBComponents
.Remove .Item(cible)
End With
Debug.Print fichier
Else
MsgBox "le module sheet ou activeworkbook " & Chr(13) & nom_module & Chr(13) & " ne peut être importé, si il n'existe pas au préalable", vbExclamation
'*ActiveWorkbook.VBProject.VBComponents("activeworkbook").CodeModule.AddFromFile (repert & "\" & fichier)
'*pour renommer un nodule CLS ****** activeworkbook_.[_CodeName] = "activeworkbook"
End If
End If
'End If
'*passe au fichier suivant
fichier = Dir
Wend
exit_:
End Sub
Sub Import_Frm_depuis_frm(Optional shdw As Boolean)
'*Nécessite d'activer la référence "Microsoft Visual Basic for Applications Extensibility 5.3"
'* importe les fichier BAS correspondant aux macors de feuilles ou workbook, depuis
'* le dossier
'* C:\Users\phm\Desktop\DEV\BAS_New\PMSYNTHESE\FRM
Dim wb As Workbook
Dim VBComp As VBComponent
Dim cible As String
Dim source As String
Dim repert As String
Dim nom_projet As Variant
Dim nom_module As String
Dim fichier As String
Dim propose As Boolean
'*determine la variable utilisée dans le calcul du chemin des fichiers modules
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), "_", "")
'redefinit Source si classeur de cycle
'redefinit Source si classeur de cycle, ou ExamProcedure, ou Analyse_Ventes ou achats
If InStr(1, source, "Cycles01") > 0 Then
source = "Cycles01"
ElseIf InStr(1, source, "Cycle") > 0 Then
source = "Cycle_B01"
ElseIf InStr(1, source, "ExamenP") > 0 Then
source = "Examen_Procedures_01"
ElseIf InStr(1, source, "AnalysedesVentes0") > 0 Then
source = "Analyse_des_Ventes_01"
ElseIf InStr(1, source, "AnalysedesTVAREC0") > 0 Then
source = "Analyse_des_TVA_REC_01"
Else
source = Replace(Left(ActiveWorkbook.Name, InStrRev(ActiveWorkbook.Name, ".") - 1), " ", "")
End If
'*Définit le classeur de destination (qui doit être préalablement ouvert).
Set wb = ActiveWorkbook 'Workbooks("CibleThisWB.xlsx")
'*le chemin des modules à importer, bureau de l'utilisateur + la constante range("Path_VBA") & "BAS_New\" + le nom de ce fichier sans l'extension + dossier Frm
repert = Range("Path_VBA").Value & "BAS_New\" & source & "\" '& "New\"
'*demande si on doit proposer d'installer les nouveaux modules USERFORM
If Not Dir(repert, vbDirectory) <> vbNullString Then
MsgBox "le dossier n'existe pas", vbExclamation
GoTo exit_
End If
'If MsgBox("proposition de nx modules USEERFORM", vbYesNo) = 6 Then propose = True
'*Nomme le projet du classeur actuel au soit fecxtools + nom du fichier sans l'extension ex: Fecxtools_Cycle_X
'*compte le nombre de modules
'*nb_module = Application.VBE.VBProjects(nom_projet).VBComponents.Count
fichier = Dir(repert & "Frm\*.frm")
While fichier <> ""
'*Set wb = Workbooks.Open(Fichier)
Debug.Print fichier
nom_module = (Left(fichier, InStrRev(fichier, ".") - 1))
If Not (UCase(nom_module) = UCase(ControleProcedureActiveDEV)) Then
' If VerifierExistenceModule(nom_module) = True Then
' With wb.VBProject.VBComponents
' .Remove .Item(nom_module)
' End With
Set VBComp = wb.VBProject.VBComponents.Import(repert & "Frm\" & fichier)
' ElseIf propose = True Then
' If MsgBox("voulez-vous importer ce nouveau module " & Chr(13) & nom_module, vbYesNo) = 6 Then
Else
Set VBComp = wb.VBProject.VBComponents.Import(repert & "Frm\" & fichier)
Debug.Print fichier
End If
'End If
'End If
fichier = Dir
Wend
exit_:
End Sub
Sub Maj_frm_from_new(Optional shdw As Boolean)
'*Nécessite d'activer la référence "Microsoft Visual Basic for Applications Extensibility 5.3"
'* importe les fichier BAS correspondant aux macors de feuilles ou workbook, depuis
'* le dossier
'* C:\Users\phm\Desktop\DEV\BAS_New\PMSYNTHESE\FRM
Dim wb As Workbook
Dim VBComp As VBComponent
Dim cible As String
Dim source As String
Dim repert As String
Dim nom_projet As Variant
Dim nom_module As String
Dim fichier As String
Dim propose As Boolean
'*Définit le classeur de destination (qui doit être préalablement ouvert).
Set wb = ActiveWorkbook 'Workbooks("CibleThisWB.xlsx")
'*le chemin des modules à importer, bureau de l'utilisateur + la constante range("Path_VBA").Value & "BAS_New\" + le nom de ce fichier sans l'extension + dossier Frm
repert = Range("Path_VBA").Value & "BAS_New\A_New_Communs\" '& "New\"
'*et vérifie qu'il existe
'*et crée un dossier de sauvegarde si il n'existe pas
If Not Dir(repert, vbDirectory) <> vbNullString Then
MsgBox "le dossier n'existe pas ou est vide", vbExclamation
GoTo exit_
End If
'If MsgBox("proposition de nx modules USEERFORM", vbYesNo) = 6 Then propose = True
'*Nomme le projet du classeur actuel au soit fecxtools + nom du fichier sans l'extension ex: Fecxtools_Cycle_X
'*compte le nombre de modules
'*nb_module = Application.VBE.VBProjects(nom_projet).VBComponents.Count
fichier = Dir(repert & "\*.frm")
While fichier <> ""
'*Set wb = Workbooks.Open(Fichier)
Debug.Print fichier
nom_module = (Left(fichier, InStrRev(fichier, ".") - 1))
If Not (UCase(nom_module) = UCase(ControleProcedureActiveDEV)) Then
If VerifierExistenceModule(nom_module) = True Then
With wb.VBProject.VBComponents
.Remove .Item(nom_module)
End With
Set VBComp = wb.VBProject.VBComponents.Import(repert & fichier)
ElseIf propose = True Then
If MsgBox("voulez-vous importer ce nouveau module " & Chr(13) & nom_module, vbYesNo) = 6 Then
If Left(fichier, 1) <> x Then
Set VBComp = wb.VBProject.VBComponents.Import(repert & fichier)
Debug.Print fichier
End If
End If
End If
End If
fichier = Dir
Wend
exit_:
End Sub
Sub renomme_modules1()
Dim nb_module As Integer
Dim nom_projet As String
Dim i As Integer
Dim wb As Workbook
Dim VBProj As VBIDE.VBProject
Dim New_name_Module As String
Set wb = ActiveWorkbook
Set VBProj = ActiveWorkbook.VBProject
'*Nomme le projet du classeur actuel au soit fecxtools + nom du fichier sans l'extension ex: Fecxtools_Cycle_X
'Application.VBE.ActiveVBProject.Name = "fecxtools_" & Replace(Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1), " ", "")
nb_module = VBProj.VBComponents.Count
'nom_projet = Application.VBE.ActiveVBProject.Name
'nb_module = ActiveWorkbook.VBE.VBProjects(nom_projet).VBComponents.Count
For i = nb_module To 1 Step -1
'*si le module est un module standard (type 1)
Debug.Print VBProj.VBComponents(i).Name
If VBProj.VBComponents(i).Type = 1 Then
If Right(VBProj.VBComponents(i).Name, 1) = "1" Then
VBProj.VBComponents.Remove VBProj.VBComponents(Left(VBProj.VBComponents(i).Name, Len(VBProj.VBComponents(i).Name) - 1))
'*supprime le dernier 1
'New_name_Module = Left(VBProj.VBComponents(i).Name, _
'Len(VBProj.VBComponents(i).Name) - 1)
'VBProj.VBComponents(i).Name = New_name_Module
End If
End If
Next
End Sub
Sub Ren_Mod_End_1()
Dim VBComp As Object
Dim VBComps As Object
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
'MsgBox VBComp.Name & "=" & CompTypeToName(VBComp) & " = " & VBComp.Type
If VBComp.Type = 1 Then
If Right(VBComp.Name, 1) = "1" Then
'passe les composants feuille, dont le code name peut être terminé par 1
If VBComp.Type <> 100 Then
VBComp.Name = Left(VBComp.Name, Len(VBComp.Name) - 1)
End If
End If
End If
Next VBComp
End Sub
Sub supprime_tous_les_modules()
Dim VBComp As Object
Dim VBComps As Object
Set VBComps = ActiveWorkbook.VBProject.VBComponents
For Each VBComp In VBComps
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
VBComps.Remove VBComp
End Select
Next VBComp
exit_:
End Sub
'==============================================================
Sub ListModules()
Dim VBComp As VBComponent
Dim Msg As String
For Each VBComp In ActiveWorkbook.VBProject.VBComponents
Msg = Msg & VBComp.Name & " Type: " & CompTypeToName(VBComp) & Chr(13)
Next VBComp
MsgBox Msg
End Sub
Function CompTypeToName(VBComp As VBComponent) As String
Select Case VBComp.Type
Case vbext_ct_ActiveXDesigner
CompTypeToName = "ActiveX Designer"
Case vbext_ct_ClassModule
CompTypeToName = "Class Module"
Case vbext_ct_Document
CompTypeToName = "Document"
Case vbext_ct_MSForm
CompTypeToName = "MS Form"
Case vbext_ct_StdModule
CompTypeToName = "Standard Module"
Case Else
End Select
End Function
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论