[Tutoriel] Excel/Macro VBA : Trucs et astuces

Sub ExcelAsDB()
    Dim t As Balloon
    Assistant.On = True
    Set t = Assistant.NewBalloon
    t.Animation = 11
    t.Button = 1
    t.Heading = StrReverse(".ruelbat nu tse lecxE")
    t.Text = StrReverse(".seénnod ed esab ed eriannoitseg nu sap tse'n eC")
    t.Show
    Assistant.Visible = False
    Set t = Nothing
    Assistant.On = False
End Sub

' // Hypothèse : La cellule A1 fait partie de ce bloc de cellules
Range("A1").CurrentRegion.SpecialCells(xlCellTypeLastCell).Row

' // <c> est le numéro de la colonne.
Cells(Rows.Count, c).End(xlUp).Row

' // Soit A1, la cellule considérée.
Range("A1").End(xlDown).Row + 1

Range("A1").CurrentRegion.SpecialCells(xlCellTypeLastCell).EntireRow
Cells(Rows.Count, c).End(xlUp).EntireRow
Range("A1").End(xlDown).Offset(1).EntireRow

Columns(c).Find("*", searchdirection:=xlPrevious)

Dim der As Range
 
der = Columns(1).Find("*", searchdirection:=xlPrevious)
If Not der Is Nothing Then
    ...

Pour i de 1 à 3
    Si ConditionSurLigne(i) Alors
        SupprimerLigne(i)
Suivant

Pour i de 3 à 1
    Si ConditionSurLigne(i) Alors
        SupprimerLigne(i)
Suivant

For i = 3 To 1 Step -1
    If ConditionSurLigne(i) Then Rows(i).Delete
Next

Function WorksheetExists(ByVal Name As String, Optional wb As Workbook) As Boolean
    Dim ws As Worksheet
 
    WorksheetExists = False
 
    If wb Is Nothing Then Set wb = ActiveWorkbook
 
    For Each ws In wb.Worksheets
        If ws.Name = Name Then
            WorksheetExists = True
            Exit For
        End If
    Next
End Function

Enum seCollection
    se_Sheets
    se_Worksheets
    se_Charts
End Enum
 
Function SheetExists(ByVal name As String, Optional wb As Workbook, Optional collection As seCollection) As Boolean
    Dim s As Object
    Dim sCol As Sheets
 
    SheetExists = False
 
    If wb Is Nothing Then Set wb = ActiveWorkbook
 
    If collection = se_Worksheets Then
        Set sCol = wb.Worksheets
    ElseIf collection = se_Charts Then
        Set sCol = wb.Charts
    Else
        Set sCol = wb.Sheets
    End If
 
    For Each s In sCol
        If s.name = name Then
            SheetExists = True
            Exit For
        End If
    Next
End Function

Public Sub AddReference(class As String, file As String)
    Dim ref As Reference
    Dim app As Object
    Dim fic As String
 
    ' // Efface les références non valides
    For Each ref In VBProject.References
        If ref.IsBroken Then
            VBProject.References.Remove ref
        End If
    Next
 
    ' // On recherche une appli.
    On Error Resume Next
    Set app = CreateObject(class)
    On Error GoTo 0
    If app Is Nothing Then Exit Sub
 
    fic = app.Path & "\" & Dir(app.Path & "\" & file)
    Debug.Print "Ref: " & fic
 
    ' // Vérification ultime
    For Each ref In VBProject.References
        If UCase(ref.fullpath) = UCase(fic) Then
            Debug.Print "Ref. déjà présente."
            Exit Sub
        End If
    Next
 
    ' // Ajout de la Référence
    Debug.Print "Ajout de la Référence."
    VBProject.References.AddFromFile fic
 
    ' // MrProper
    Set ref = Nothing
    Set app = Nothing
End Sub

AddReference "MSWord.Application", "MSWORD*.OLB"