1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
| Private Sub Workbook_Open()
If Not (ThisWorkbook.ReadOnly) Then
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'===================================================================================================
'Mise à jour de la base de données
'===================================================================================================
Worksheets("Base").Range("A2:I4000").ClearContents
Dim Source As ADODB.Connection
Dim Rst As ADODB.Recordset
Dim ADOCommand As ADODB.Command
Dim Fichier As String, Plage As String, Feuille As String
Plage = "A2:I4000"
Feuille = "Base$"
Fichier = "" & Worksheets("Paramètres").Cells(5, 3) & ""
Set Source = New ADODB.Connection
Source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";Extended Properties=""Excel 8.0;IMEX=1;HDR=No;"";"
Set ADOCommand = New ADODB.Command
With ADOCommand
.ActiveConnection = Source
.CommandText = "SELECT * FROM [" & Feuille & Plage & "]"
End With
Set Rst = New ADODB.Recordset
Rst.Open ADOCommand, , adOpenKeyset, adLockOptimistic
Set Rst = Source.Execute("[" & Feuille & Plage & "]")
ThisWorkbook.Worksheets("Base").Range("A2").CopyFromRecordset Rst
Rst.Close
Source.Close
Worksheets("Base").Visible = True
Worksheets("Base").Activate
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1)
Worksheets("Base").Visible = False
Set Source = Nothing
Set Rst = Nothing
Set ADOCommand = Nothing
'Liste PETRI
If Worksheets("Liste PETRI").AutoFilterMode Then
Worksheets("Liste PETRI").Rows("2:2").AutoFilter
Worksheets("Liste PETRI").Rows("2:2").AutoFilter
Else
Worksheets("Liste PETRI").Rows("2:2").AutoFilter
End If
'Liste T&F
If Worksheets("Liste T&F").AutoFilterMode Then
Worksheets("Liste T&F").Rows("2:2").AutoFilter
Worksheets("Liste T&F").Rows("2:2").AutoFilter
Else
Worksheets("Liste T&F").Rows("2:2").AutoFilter
End If
Application.Windows(ThisWorkbook.Name).Visible = True
End If |
Partager