'https://eileenslounge.com/viewtopic.php?t=33779
Sub CopyModule()
Dim strPath As String
Dim strModule As String
Dim strFile As String
Dim wbk As Workbook
' Path to source workbook
strPath = ThisWorkbook.Path & "\"
' Module to export
strModule = "Module2"
' Path to export module to
strFile = strPath & strModule & ".bas"
' Export module
ThisWorkbook.VBProject.VBComponents(strModule).Export Filename:=strFile
FichierSecret = ActiveWorkbook.Name
Call OuvrirFile1
' Loop through open workbooks
For Each wbk In Workbooks
' Exclude source workbook, personal macro workbook and add-ins
If wbk.Name <> ThisWorkbook.Name And wbk.Name <> FichierSecret And wbk.IsAddin = False Then
' Import module
wbk.VBProject.VBComponents.Import Filename:=strFile
' Save workbook
wbk.Save
End If
Next wbk
' Delete exported module
Kill strFile
End Sub
'Macro Ouvrir un fichier Excel
Private Sub OuvrirFile1()
Dim Chemin As String, NomFichier As String
'Chemin = Path_Source
'NomFichier = SourceFile
Chemin = "P:\"
NomFichier = "Classeur2.xlsm"
Workbooks.Open Filename:=Chemin & NomFichier
End Sub
'http://www.cpearson.com/Excel/vbe.aspx
' A exécuter dans le classeur qui importe le module
Sub DeleteModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Module4")
VBProj.VBComponents.Remove VBComp
End Sub
Sub AnonymizeText()
'PURPOSE: Anonymize a number or text so only certain amount of original characters are showing (used alot with credit card #s)
'SOURCE: www.TheSpreadsheetGuru.com
Dim ShowChars As Integer
Dim AnonymChar As String
Dim SymbolString As String
Dim StringLength As Long
Dim AnonymEnd As Boolean
Dim cell As Range
Dim rng As Range
'Do you want to anonymize begining or end of text (TRUE for end, FALSE for beginning)
AnonymEnd = False
'Number of characters you want to show
ShowChars = 4
'Symbol you want to replace original characters
AnonymChar = "*"
'Range where data is stored
Set rng = Range("A2:A25")
'Loop through each cell and anonymize text
For Each cell In rng.Cells
StringLength = Len(cell.Value)
SymbolString = Application.WorksheetFunction.Rept(AnonymChar, StringLength - ShowChars)
If StringLength > ShowChars Then
'Anonymize ending characters (ie 730*******)
If AnonymEnd = True Then cell.Value = Left(cell.Value, ShowChars) & SymbolString
'Anonymize beginning characters (ie *******540)
If AnonymEnd = False Then cell.Value = SymbolString & Right(cell.Value, ShowChars)
End If
Next cell
End Sub