ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets.Item(ActiveWorkbook.Sheets.Count), Type:=xlChart

Dim objFeuille As Worksheet

Set objFeuille = ActiveWorkbook.ActiveSheet

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If Not Application.Intersect("Target", Range("A1")) Is Nothing Then
        .........
    End If
End Sub

Sub LimiteDefilement()
  ActiveSheet.ScrollArea = "A1:G50"
End Sub

Private Sub Workbook_Open()
    Worksheets ("Feuil1").ScrollArea = "A1:G50"
End Sub

Sub RetablitDefilement()
  ActiveSheet.ScrollArea = ""
End Sub 

Sub test()
    supprimerFeuillesVides ThisWorkbook
End Sub

Sub supprimerFeuillesVides(Wb As Workbook)
    Dim Ws As Worksheet
    
    Application.ScreenUpdating = False
    
    For Each Ws In Wb.Worksheets
        If Ws.UsedRange.Cells.Address = "$A$1" And _
                IsEmpty(Ws.Range("A1")) And Ws.Shapes.Count = 0 Then
            
            Application.DisplayAlerts = False
            If Wb.Worksheets.Count > 1 Then Ws.Delete
            Application.DisplayAlerts = True
            
        End If
    Next Ws
    
    Application.ScreenUpdating = True
    
End Sub

Application.CommandBars("Workbook tabs").ShowPopup 400, 100

NumCol = Cells(1, 72).Column
MsgBox IIf(NumCol > 26, Chr(64 + NumCol \ 26) & Chr(64 + NumCol Mod 26), Chr(64 + NumCol))

MsgBox Split(Range("Plage").Address(1, 0), "$")(0)

Split(MaPlage.Address, "$")(1)

'-- Applique une couleur jaune à l'onglet de la Feuil1 
WorkSheets("Feuil1").Tab.ColorIndex = 6

Dim i As Integer
Dim Wb As Workbook
 
Set Wb = ThisWorkbook
 
MsgBox Wb.Worksheets(1).VPageBreaks.Count
 
For i = Wb.Worksheets(1).VPageBreaks.Count To 1 Step -1
    If Wb.Worksheets(1).VPageBreaks(i).Type = xlPageBreakManual Then _
        Wb.Worksheets(1).VPageBreaks(i).Delete
 
Next

Worksheets(1).ResetAllPageBreaks

Feuil4.Range("B2").Consolidate Sources:=Array("[NomClasseur.xls]Feuil1!R1C1:R10C4", _
        "[NomClasseur.xls]Feuil2!R1C1:R5C4", "[NomClasseur.xls]Feuil3!R1C1:R5C4"), _
        Function:=xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False

Private Sub Workbook_Open()
    'testé sous Excel2007
    Dim Fichier As String
    
    Fichier = ThisWorkbook.FullName
    Application.DisplayAlerts = False
 
    'Protège la feuille "Feuil3" et autorise les modifications uniquement par macro (UserInterfaceOnly:=True)
    With ActiveWorkbook
        .ExclusiveAccess
        .UnprotectSharing '"Password"
        .Worksheets("Feuil3").Protect Contents:=True, UserInterfaceOnly:=True
        .ProtectSharing Filename:=Fichier ', Password:="Password"
    End With
    
    Application.DisplayAlerts = True
End Sub

Sub ListeFeuillesClasseurFerme() 
    Dim XlConnect As Object, XlCatalog As Object 
    Dim Fichier As String, Resultat As String 
    Dim Feuille As Object 
    
    Fichier = "C:\dossier\Nom classeur.xls" 
    
    Set XlConnect = CreateObject("ADODB.Connection") 
    Set XlCatalog = CreateObject("ADOX.Catalog") 
    
    XlConnect.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & _ 
            ";Extended Properties=Excel 8.0;" 
    Set XlCatalog.ActiveConnection = XlConnect 
        
    For Each Feuille In XlCatalog.Tables 
        Resultat = Resultat & Feuille.Name & vbCrLf 
    Next 
          
    MsgBox Resultat 
End Sub 

Sub Test()
    MsgBox WorksheetExist("C:\dossier\rapport.xls", "Feuil1")
End Sub


Function WorksheetExist(XlFile As String, strWsName As String) As Boolean
    Dim XlConnect As Object, XlCatalog As Object
    Dim Feuille As Object
    
    Set XlConnect = CreateObject("ADODB.Connection")
    Set XlCatalog = CreateObject("ADOX.Catalog")
    
    XlConnect.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & XlFile & _
            ";Extended Properties=Excel 8.0;"
    Set XlCatalog.ActiveConnection = XlConnect
    
    On Error Resume Next
    Set Feuille = XlCatalog.Tables(strWsName & "$")
    On Error GoTo 0
    
    If Feuille Is Nothing Then
        WorksheetExist = False
    Else
        WorksheetExist = True
    End If
          
    XlConnect.Close
    Set XlConnect = Nothing
End Function

Sub EffacerContenuFeuille_ClasseurFerme()
    Dim Cn As ADODB.Connection
    Dim Fichier As String
    
    Fichier = "C:\dossier\NomClasseur.xls"
    
    Set Cn = New ADODB.Connection
    With Cn
        .Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & _
            ";Extended Properties=Excel 8.0;"
        .Execute "DROP TABLE [Feuil1$]"
        .Close
    End With
    
    Set Cn = Nothing
End Sub

Sub EffacerContenuFeuille_ClasseurFerme_V02()
    Dim Cat As ADOX.Catalog
    Dim Fichier As String
    
    Fichier = "C:\dossier\NomClasseur.xls"
    
    Set Cat = New ADOX.Catalog
    Cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Fichier & _
            ";Extended Properties=Excel 8.0;"
    Cat.Tables.Delete ("Feuil1$")
    
    Set Cat = Nothing
End Sub