top of page


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
        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


' 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)

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


bottom of page