Sub Test()
    MsgBox IsProtectedProjetVBE(Workbooks("NomClasseur.xls"))
End Sub
 
 
Function IsProtectedProjetVBE(Wb As Workbook) As Boolean
    Dim i As Integer
 
    On Error Resume Next
    i = Wb.VBProject.VBComponents.Count
    On Error GoTo 0
 
    IsProtectedProjetVBE = IIf(i = 0, True, False)
End Function

Sub RemplacementMotDansProcedure()
    'Nécéssite d'activer la référence
    '"Visual basic For Application Extensibility 5.3"
    '
    Dim Ancien As String, Nouveau As String, Cible As String
    Dim VBComp As VBComponent
    Dim i As Integer
    Dim Wb As Workbook
 
    Set Wb = Workbooks("NomClasseur.xls")
 
    Ancien = "Feuil1"
    Nouveau = "Feuil3"
 
    For Each VBComp In Wb.VBProject.VBComponents
        For i = 1 To VBComp.CodeModule.CountOfLines
            Cible = VBComp.CodeModule.Lines(i, 1)
            Cible = Replace(Cible, Ancien, Nouveau)
            VBComp.CodeModule.ReplaceLine i, Cible
        Next i
    Next VBComp
End Sub

'Supprimer la macro nommée "MaMacro" dans le "module3"
Sub supprimerUneMacroPrecise()
Dim Debut As Integer, Lignes As Integer
 
    With ThisWorkbook.VBProject.VBComponents("Module3").CodeModule
        Debut = .ProcStartLine("MaMacro", 0)
        Lignes = .ProcCountLines("MaMacro", 0)
        .DeleteLines Debut, Lignes
    End With
End Sub

Sub supprimerTousModulesVides()
    Dim vbComp As VBComponent
    Dim i As Integer, j As Integer
 
    For Each vbComp In ActiveWorkbook.VBProject.VBComponents
        If vbComp.Type = 1 Then
            i = vbComp.CodeModule.CountOfDeclarationLines + 1
            j = vbComp.CodeModule.CountOfLines
            If j < i Then ActiveWorkbook.VBProject.VBComponents.Remove vbComp
        End If
    Next
End Sub

Sub Test()
    Dim Donnee As Integer
 
    Donnee = 50
 
    MaProcedure_1 Donnee
    MsgBox Donnee
 
    MaProcedure_2 Donnee
    MsgBox Donnee
 
    MaProcedure_3 Donnee
    MsgBox Donnee
End Sub
 
 
'Passe la référence en argument.
Sub MaProcedure_1(ByRef x As Integer)
    x = x * 2
End Sub
 
 
'Passe la valeur en argument.
Sub MaProcedure_2(ByVal y As Integer)
    y = y * 2
End Sub
 
 
'ByRef est la valeur par défaut si non spécifiée.
Sub MaProcedure_3(z As Integer)
    z = z * 2
End Sub

Option Explicit
 
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
Sub LaMacro_V01()
    'tempo 1 seconde
    Sleep 1000 'pause en millisecondes
    'la suite de la macro
    MsgBox "test"
End Sub

Sub LaMacro_V02()
    Dim t As Date
    'Tempo 1 seconde
    t = Timer + 1: Do Until Timer > t: DoEvents: Loop
    MsgBox "test"
End Sub

Sub LaMacro_V03()
    'tempo 1 seconde
    Application.Wait (Now + TimeValue("0:00:01"))
 
    MsgBox "test"
End Sub

Public Function Log10(ByVal X As Single) As Single
    Log10 = Log(X) / Log(10#)
End Function

Result = Application.Run("calcul.xls!Log10", 1.2)

Sub AfficherMasquer_OngletDeveloppeur()
    With Application
        If .ShowDevTools = False Then
            .ShowDevTools = True
            Else
            .ShowDevTools = False
        End If
    End With
End Sub

Dim MaVariable As String
 
MaVariable = """"
MsgBox MaVariable

Dim MaVariable As String
 
MaVariable = Chr(34)
MsgBox MaVariable

Sub test()
    NomFonction Arg1:=0, Arg2:=56765765
    NomFonction Arg1:=453
    NomFonction Arg2:=56765765
    NomFonction
End Sub
 
 
Function NomFonction(Optional Arg1 As Variant, Optional Arg2 As Variant) As Variant
    MsgBox "Arguments manquants:" & vbCrLf & _
        IsMissing(Arg1) & " / " & IsMissing(Arg2)
End Function

'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
 
Cible = "NomModule"
'Définit le classeur de destination (qui doit être préalablement ouvert).
Set Wb = Workbooks("NomClasseur.xls")
 
'Charge le module dans le classeur
Set VbComp = Wb.VBProject.VBComponents.Import("C:\ThisWorkbook.cls")
'Le renomme (pour le supprimer plus facilement ultérieurement
VbComp.Name = Cible
 
Set oModule = VbComp.CodeModule
 
'Transfère les données chargées dans ThisWorkbook.
'Attention les données existantes dans "ThisWorkbook" sont écrasées.
With Wb.VBProject.VBComponents("ThisWorkbook").CodeModule
    x = .CountOfLines
    .DeleteLines 1, x
    .InsertLines 1, oModule.Lines(1, oModule.CountOfLines)
End With
 
'Suppression du module précédemment chargé
With Wb.VBProject.VBComponents
    .Remove .Item(Cible)
End With

Sub Test()
    Application.OnTime Now + TimeValue("00:00:03"), "'NomMacro ""mimi"", 50'"
End Sub
 
 
Sub NomMacro(Arg1 As String, Arg2 As Integer)
    MsgBox Arg1 & vbCrLf & Arg2
End Sub

Sub Test()
    'Renvoie tous les arguments spécifiés
    MsgBox MaProcedure(5, "fifi")
    'Renvoie 5 et "mimi" car l'argument Optional (strPrenom) n'est pas précisé
    MsgBox MaProcedure(5)
End Sub
 
 
Function MaProcedure(lngValeur As Long, Optional strPrenom As String = "mimi")
    MaProcedure = lngValeur & vbCrLf & strPrenom
End Function

Private Sub Workbook_Open()
    Dim vbpName As String
 
    On Error Resume Next
 
    vbpName = ThisWorkbook.VBProject.Name
    If vbpName = vbNullString Then MsgBox "Veuillez cocher ..."
End Sub

'Nécessite d'activer la référence :
'Microsoft Visual Basic for Applications Extensibility 5.3
Function ContientMacro(Wb As Workbook) As Boolean
    Dim VbComp As VBComponent
 
    For Each VbComp In Wb.VBProject.VBComponents
        With VbComp.CodeModule
              ContientMacro = .CountOfDeclarationLines + 1 < .CountOfLines
        End With
 
        If ContientMacro Then Exit For
    Next VbComp
End Function

'le fichier "NomClasseur.xls" doit être préalablement ouvert.
MsgBox Workbooks("NomClasseur.xls").HasVBProject

Sub NomMacro()
    Dim x As Integer
 
    x = 7
    x = x * 3
    Debug.Print "premier calcul: " & x
 
    x = x + 4
    Debug.Print "deuxième calcul: " & x
End Sub

MsgBox 10 / 3
MsgBox 10 \ 3

Option Explicit
 
Public instObj As user
 
 
Sub Instanciation()
    Set instObj = New user
End Sub

Option Explicit
Private EventHandlers As Collection
 
 
Private Sub Class_Initialize()
    Dim VBEControls As CommandBarControls
    Dim VBEControl As VbeControlEvent
    Dim j As Long
 
    MsgBox ("Un user vient d'être instancié")
 
    Set EventHandlers = New Collection
    Set VBEControls = Application.VBE.CommandBars.FindControls(, 228)
 
    For j = 1 To VBEControls.Count
        Set VBEControl = New VbeControlEvent
        Set VBEControl.Control = Application.VBE.Events.CommandBarEvents(VBEControls(j))
        EventHandlers.Add VBEControl
    Next
End Sub

Option Explicit
 
Public WithEvents Control As CommandBarEvents
 
 
Private Sub Control_Click(ByVal CommandBarControl As Object, _
    handled As Boolean, CancelDefault As Boolean)
 
    MsgBox "Click sur stop"
End Sub

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias _
        "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
        ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, _
        ByVal lpFileName As String) As Long
 
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias _
        "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, _
        ByVal lpString As Any, ByVal lpFileName As String) As Long
 
Function EcrireINI(Entete As String, Variable As String, Valeur As String) As String
    Dim Fichier As String
    Fichier = "C:\temp\MyAddin.ini"
    WriteINI = WritePrivateProfileString(Entete, Variable, Valeur, Fichier)
End Function
 
Function LireINI(Entete As String, Variable As String) As String
    Dim Retour As String
    Dim Fichier As String
    Fichier = "C:\temp\MyAddin.ini"
    Retour = String(255, Chr(0))
    LireINI = Left$(Retour, GetPrivateProfileString(Entete, ByVal Variable, "", Retour, Len(Retour), Fichier))
End Function

Private Sub Workbook_Open()
 
' check UPDATE
If LireINI("Main", "lastCheckUpdate") & "" = "" Then
    CheckVersion
    EcrireINI "Main", "lastCheckUpdate", Format(Now, "dd/mm/yyyy hh:nn:ss")
Else
    If CDate(LireINI("Main", "lastCheckUpdate")) + 7 < Now Then
        CheckVersion
        EcrireINI "Main", "lastCheckUpdate", Format(Now, "dd/mm/yyyy hh:nn:ss")
    End If
End If
 
End Sub

Sub CheckVersion()
 
    Dim fso As FileSystemObject
    Dim ad As AddIn
 
    Set fso = New FileSystemObject
 
    For Each ad In application.AddIns
        If ad.FullName Like "*MyAddin.xla" Then
            If fso.GetFile(ad.FullName).DateLastModified < _
       fso.GetFile("\\LecteurReseau\...\Divers\MyAddin.xla").DateLastModified Then
                rep = MsgBox("Votre version de l'Add-in n'est plus à jour." & vbCrLf & _
                            "Voulez-vous mettre à jour votre Add-in ?", vbInformation + vbYesNo, "MyAddin")
                If rep = vbYes Then
                    ' il faut mettre à jour
                    On Error Resume Next
                    Kill Left(ad.FullName, Len(ad.FullName) - 4) & "(old).xla"
                    ThisWorkbook.SaveAs Left(ad.FullName, Len(ad.FullName) - 4) & "(old).xla"
                    FileCopy _
                            "\\LecteurReseau\...\Divers\MyAddin.xla", _
                            ad.FullName
                    MsgBox "La mise à jour de votre Add-in a été effectuée." & vbCrLf & _
                           "Redémarrez Excel pour qu'elle soit effective", vbInformation + vbOKOnly, _
                           "MyAddin"
                Else
                    MsgBox "La prochaine vérification aura lieu dans une semaine !", _
                            vbCritical + vbOKOnly, _
                            "MyAddin"
                End If
            End If
        End If
    Next ad
 
    Set fso = Nothing
    Set ad = Nothing
End Sub

[ADMIN]
EnablePublishing=True

Public Const FullPathAddin As String = _
    "\\serveur\MyAddin.xla"
Public Const FullPathGetVer As String = _
    "\\serveur\AddinVersion.txt"
 
Sub PublishAddin()
 
    Dim fso As FileSystemObject
    Dim fic As TextStream
    Dim ad As AddIn
 
    Set fso = New FileSystemObject
 
        For Each ad In application.AddIns
            If ad.FullName Like "*MyAddin*.xla" Then
                ' copie le fichier
                On Error Resume Next
                Kill Left(ad.FullName, Len(ad.FullName) - 4) & "(publish).xla"
                ThisWorkbook.SaveAs Left(ad.FullName, Len(ad.FullName) - 4) & "(publish).xla"
                FileCopy ad.FullName, FullPathAddin
 
                ' crée le fichier de version
                Set fic = fso.CreateTextFile(FullPathGetVer, True)
                fic.Write InputBox("Entrez la date de mise à jour de l'Add-in", "MyAddin Admin", _
                          Format(fso.GetFile(ad.FullName).DateLastModified, "dd/mm/yy hh:nn"))
 
                ' revient sur le fichier original
                Kill ad.FullName
                ThisWorkbook.SaveAs ad.FullName
 
                MsgBox "Le fichier a bien été publié !", vbInformation + vbOKOnly, _
                        "MyAddin Admin"
 
            End If
        Next ad
    Set fso = Nothing
    Set fic = Nothing
    Set ad = Nothing
End Sub

Sub Test()
    Dim i As Integer
 
    i = 1
 
    Essai (i)
    MsgBox i
 
    Essai i
    MsgBox i
End Sub
 
 
Sub Essai(ByRef j As Integer)
    j = j + 1
End Sub

Dim oAddIn As AddIn
 
Set oAddIn = Application.AddIns.Add(Filename:="C:\Program Files\IBM\Client Access\Shared\cwbtfxla.xll")
 
oAddIn.Installed = True
Application.RegisterXLL "cwbtfxla.xll"
 
'Lance la procédure "fShowTTODialog" contenue dans le fichier xll
Application.Run ("fShowTTODialog")

'Nécessite d'activer la référence
    'Microsoft "Visual basic For Application Extensibility 5.3"
Dim Ajout As Integer
Dim VBCmp As VBComponent
Dim cdMod As CodeModule
Dim Wb As Workbook
Dim Debut As Long
 
'Indiquez le nom du classeur ouvert
'Set Wb = ThisWorkbook
Set Wb = Workbooks("Classeur1.xls")
Ajout = 1
 
'Boucle sur tous les composants du projet :
    'Modules standards
    'Modules de feuilles et de classeur
    'Modules de classe
    'UserForms
For Each VBCmp In Wb.VBProject.VBComponents
    Set cdMod = VBCmp.CodeModule
 
    With cdMod
        Debut = .CountOfDeclarationLines + 1
        Do Until Debut >= .CountOfLines
            'Nom de la procédure
            Debug.Print .ProcOfLine(Debut, vbext_pk_Proc)
            Debut = Debut + _
                .ProcCountLines(.ProcOfLine(Debut, _
                vbext_pk_Proc), vbext_pk_Proc)
            Ajout = Ajout + 1
        Loop
    End With
 
Next VBCmp

Debug.Print .Lines(.ProcBodyLine(.ProcOfLine(Debut, vbext_pk_Proc), vbext_pk_Proc), 1)

Sub listeMacros()
'Nécessite d'activer la référence
    '"Visual basic For Application Extensibility 5.3"
 
Dim i As Integer, Ajout As Integer, x As Integer
Dim Msg As String
Dim VBCmp As VBComponent
Dim Wb As Workbook
 
'Indiquez le nom du classeur (ouvert)
'Set Wb = ThisWorkbook
Set Wb = Workbooks("Classeur1.xls")
 
Ajout = 1
For Each VBCmp In Wb.VBProject.VBComponents
    Msg = VBCmp.Name
 
    With Cells(Ajout, 1)
        .Interior.ColorIndex = 6
        .Value = Msg
    End With
 
    x = Wb.VBProject.VBComponents(Msg).CodeModule.CountOfLines
    For i = 1 To x
        Cells(Ajout + i, 1) = _
            Wb.VBProject.VBComponents(Msg).CodeModule.Lines(i, 1)
    Next
 
    Ajout = Ajout + x + 2
Next VBCmp
End Sub

x = Left(strVariable, 1)

x = VBA.Left(strVariable, 1)

Sub ClasseurAutreInstance()
    Dim Wb As Workbook
    Dim Chemin As String
 
    Chemin = "C:\dossier\nomClasseur.xls"
 
    Set Wb = GetObject(Chemin)
    If Not Wb Is Nothing Then _
        Wb.Parent.Run "'nomClasseur.xls'!Module1.nomMacro"
 
End Sub

Sub Test()
    Dim x As Double
 
    'Exemple pour un angle de 30 degrés.
    'Transformation en radians :
    x = 30 * Application.WorksheetFunction.Pi / 180
 
    'Résultats :
    MsgBox Cos(x) 'cosinus
    MsgBox 1 / Cos(x) 'secante
    MsgBox Sin(x) 'sinus
    MsgBox 1 / Sin(x) 'cosecante
    MsgBox Tan(x) 'tangente
    MsgBox 1 / Tan(x) 'cotangente
End Sub

Option Explicit
 
Public Collect As New Collection

Option Explicit
 
Private Sub Workbook_Open()
    Dim cbEvent As Classe1
    Dim cBar As CommandBar
    Dim cbButton As CommandBarButton
    Dim i As Integer
 
    'Suppression de la barre si elle existait déjà.
    On Error Resume Next
    Application.VBE.CommandBars("Ma barre perso VBE").Delete
    On Error GoTo 0
 
    'Ajoute la nouvelle barre dans l'éditeur de macros
    Set cBar = Application.VBE.CommandBars.Add("Ma barre perso VBE", , True, True)
    cBar.Visible = True
 
    For i = 1 To 3
        Set cbButton = cBar.Controls.Add(msoControlButton)
            With cbButton
            .Caption = "Le bouton perso " & i
            .FaceId = 350 + i
            .Tag = "Btn0" & i
            .OnAction = "LaMacro" & i
        End With
 
        Set cbEvent = New Classe1
        Set cbEvent.objEvents = Application.VBE.Events.CommandBarEvents(cbButton)
 
        'Ajoute un élément dans la collection
        Collect.Add cbEvent
    Next i
End Sub
 
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.VBE.CommandBars("Ma barre perso VBE").Delete
End Sub

Option Explicit
 
'Nécessite d'activer la référence :
'Microsoft Visual Basic for Applications Extensibility 5.3
'
Public WithEvents objEvents As CommandBarEvents
 
 
Private Sub objEvents_Click(ByVal cbControl As Object, _
    Handled As Boolean, CancelDefault As Boolean)
 
    'Application.Run cbControl.OnAction
 
    MsgBox cbControl.Tag
 
    Handled = True
    CancelDefault = True
 
End Sub