Application.SheetsInNewWorkbook = 1
Application.Workbooks.Add

Application.Workbooks.Add xlWBATWorksheet

Application.Workbooks.Add xlWBATChart

Application.Workbooks.Open "d:\tuto.xls"

Application.Workbooks.Open Application.GetOpenFilename()

Dim objWorkbookSource As Workbook, objWorkbookCible As Workbook

Set objWorkbookSource = Workbooks.Open(Application.GetOpenFilename)
Set objWorkbookCible = Workbooks.Add()

ActiveWorkbook.Protect Password:="monpasse", Structure:=True, Windows:=False

ThisWorkbook.Worksheets.FillAcrossSheets Range("A1:C10"), xlFillWithAll

 
Private Sub Workbook_BeforeClose(Cancel As Boolean) 
    Cancel=true 
End Sub

Application.EnableEvents = False
ThisWorkbook.Close True

Dim Cn As ADODB.Connection
Dim Fichier As String
    
'Définit le classeur fermé servant de base de données
Fichier = "C:\Documents and Settings\mimi\dossier\NomClasseur.xlsx"
    
Set Cn = New ADODB.Connection

With Cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
End With

Sub OuvertureClasseur()
    Dim Fichier As String
    Dim Wb As Workbook
    
    Fichier = "C:\monClasseurBase.xls"
    
    'Désactive les évènements
    Application.EnableEvents = False
    'Ouvre le classeur
    Set Wb = Workbooks.Open(Filename:=Fichier)
    'Ne pas oublier de réactiver les évènements
    Application.EnableEvents = True
    
    '
    '...
    '
End Sub

'Attention:
'Si le fichier existe déjà il sera éceasé sans message d'avertissement.
'
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:="C:\Documents and Settings\mimi\dossier\NomClasseur.pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False			

Worksheets("Agenda").Range("A1:M42").ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:="C:\Documents and Settings\mimi\dossier\RapportTest.pdf", _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False

Option Explicit
 
Public WithEvents XL As Excel.Application
 

Private Sub Workbook_Open()
  Set XL = Excel.Application
End Sub
 
 
Private Sub XL_WorkbookOpen(ByVal Wb As Workbook)
    'Affiche le nom du nouveau classeur ouvert
    If Wb.Name <> ThisWorkbook.Name Then MsgBox Wb.Name
End Sub

Sub Test()
    If VerifOuvertureClasseur("C:\Dossier\nom classeur.xls") Then
        MsgBox "Classeur déja ouvert."
    Else
        MsgBox "Classeur fermé."
    End If
End Sub


Function VerifOuvertureClasseur(Fichier As String) As Boolean
    Dim x As Integer

    On Error Resume Next
    x = FreeFile()

    Open Fichier For Input Lock Read As #x
    Close x

    If Err.Number = 0 Then VerifOuvertureClasseur = False
    If Err.Number = 70 Then VerifOuvertureClasseur = True

    On Error GoTo 0
End Function

Sub tranfertEntreClasseursFermes()
Dim Cn As New ADODB.Connection
Dim oProdRS As New ADODB.Recordset, oRS As ADODB.Recordset
Dim oConn As ADODB.Connection
Dim j As Integer
 
'------------------------------------------------------------------
' "Classeur1_Fermé.xls" est le classeur source
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ThisWorkbook.Path & "\Classeur1_Fermé.xls;" & _
    "Extended Properties=""Excel 8.0;HDR=NO;"""
               
'les donnees sources sont dans la Feuil1 du classeur "Classeur1_Fermé.xls"
oProdRS.Open "SELECT * FROM [Feuil1$]", Cn, adOpenStatic
 
 
'------------------------------------------------------------------
' "Classeur2_Fermé.xls" est le classeur destination
Set oConn = New ADODB.Connection
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & ThisWorkbook.Path & "\Classeur2_Fermé.xls;" & _
    "Extended Properties=""Excel 8.0;HDR=NO;"""
 
'les donnees sont à placer dans la Feuil1 du classeur "Classeur2_Fermé.xls"
Set oRS = New ADODB.Recordset
oRS.Open "Select * from [Feuil1$]", oConn, adOpenKeyset, adLockOptimistic
    
'------------------------------------------------------------------
'transfert des données
Do While Not (oProdRS.EOF)
    oRS.AddNew
        For j = 0 To oRS.Fields.Count - 1
        oRS.Fields(j) = oProdRS.Fields(j).Value
        Next j
    oRS.Update
    oProdRS.MoveNext
Loop
    
oProdRS.Close
Cn.Close
oRS.Close
oConn.Close
End Sub

Option Explicit

'Définit l'emplacement et le nom du fichier .txt, ou va être enregistré les
'informations d'ouverture et de fermeture.
Private Const Chemin As String = "J:\dossier\journal.txt"


'Evenement ouverture du classeur
Private Sub Workbook_Open()
    Dim Cible As Integer
    
    Cible = FreeFile
        
    Open Chemin For Append As #Cible
        Print #Cible, Now & ";Ouverture;" & Environ("UserName")
    Close #Cible
End Sub


'Evenement déclenché avant la fermeture du classeur
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Cible As Integer
    
    Cible = FreeFile
        
    Open Chemin For Append As #Cible
        Print #Cible, Now & ";Fermeture;" & Environ("UserName")
    Close #Cible
End Sub

Workbooks("MonClasseur").Activate

Workbooks("MonClasseur.xls").Activate

Workbooks.Open "MonClasseur"

Sub AppelAutoDocument(ByVal Doc As String, Optional MAJLiaisons, Optional ByVal Chemin, Optional Dep As Boolean)
    On Error Resume Next
    Workbooks(Doc).Activate
        If Err.Number = 0 Then
            ' Deprotection éventuelle
                If Not IsMissing(Dep) Then
                    If Dep Then Deprotege
                End If
            Exit Sub
        End If
    On Error GoTo Ouvre
    Workbooks(Doc & ".xls").Activate
        If Err.Number = 0 Then
            ' Deprotection éventuelle
                If Not IsMissing(Dep) Then
                    If Dep Then Deprotege
                End If
            Exit Sub
        End If
    On Error GoTo 0
    Exit Sub
Ouvre:
    ChDir ThisWorkbook.Path
    ' MAJ Doc si un nom de chemin a été fourni
        If Not IsMissing(Chemin) Then
            Doc = Chemin & Application.PathSeparator & Doc
        End If
    ' Prise en compte liaisons si info fournie
        If Not IsMissing(MAJLiaisons) Then
            Workbooks.Open Doc, MAJLiaisons
        Else
            Workbooks.Open Doc
        End If
    ' Deprotection éventuelle
        If Not IsMissing(Dep) Then
            If Dep Then Deprotege
        End If
    On Error GoTo 0
End Sub

    On Error Resume Next
    Workbooks(Doc).Activate
        If Err.Number = 0 Then
            ' Deprotection éventuelle
            ' Cf la procédure complète ci-dessus
            Exit Sub
        End If
    On Error GoTo Ouvre
    Workbooks(Doc & ".xls").Activate
        If Err.Number = 0 Then
            ' Deprotection éventuelle
            ' Cf la procédure complète ci-dessus
            Exit Sub
        End If

Workbooks(Doc).Activate

Dim wb as Workbook
    Workbooks("Document")
    Set wb = ActiveWorkbook
    ' ...

wb.Activate

wb.Close