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
| Sub Lancer_Procedure_test()
effet_bord
Test_effet_bord_ado
effet_bord
End Sub
Sub Test_effet_bord_ado()
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim t0 As Double, t1 As Double
t0 = Time
Application.ScreenUpdating = False
If ActiveWorkbook.Path = "" Then
MsgBox "vous devez enregistrer ce fichier!"
Exit Sub
End If
Set s1 = Worksheets("Feuil1")
Set S2 = Worksheets("Feuil2")
Set SR = Worksheets("Feuil3") 'Worksheets("SQL_COMMUNS")
strFile = ActiveWorkbook.FullName
''Note HDR=Yes, the names in the first row of the range
''can be used.
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
'-------------COMMUNS-----------------------------
strSQL = "SELECT distinct s2.SIREN FROM [" & S2.Name & "$] s2 " _
& "INNER JOIN [" & s1.Name & "$] s1 ON s2.SIREN=s1.SIREN"
rs.Open strSQL, cn, 0, 3
rs.Close
cn.Close
Set cn = Nothing
Set rs = Nothing
Application.ScreenUpdating = True
MsgBox prompt:="Terminé ! : " + CStr(Time - t0)
End Sub
Sub effet_bord()
Dim t0 As Double, i
t0 = Time
Application.ScreenUpdating = False
Set s1 = Worksheets("Feuil1")
For i = 2 To s1.Cells(Rows.Count, 1).End(xlUp).Row
s1.Cells(i, 2).Value = "OK"
Next i
Application.ScreenUpdating = True
MsgBox prompt:="Terminé ! : " + CStr(Time - t0)
End Sub |
Partager