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
| Sub NoDevis()
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim CheminNoDevis As String
Dim NomFeuille As String
Dim NomCol As String
Dim Cellule As String
Dim i As Integer
CheminNoDevis = "Y:\BDD\Compteur.xls"
NomFeuille = [I25] 'Soit le type de document, une feuille par type de doc
Set Cn = New ADODB.Connection
' pour Xl 2007
Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & CheminNoDevis & ";" & _
"Extended Properties=""Excel 12.0;HDR=no;"""
'Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CheminNoDevis & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
'------------------
Cd.CommandText = "SELECT * FROM [" & NomFeuille & "$]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
Dim NumeroDevis As Long
NumeroDevis = Rst.RecordCount + 1
'MsgBox NumeroDevis
Rst.Close
Set Rst = Nothing
'------------------------
Dim tablo(1 To 2) As Variant
tablo(1) = NumeroDevis
tablo(2) = Date
For i = 1 To UBound(tablo)
Cellule = Cells(NumeroDevis, i).Address(0, 0) & ":" & Cells(NumeroDevis, i).Address(0, 0)
Cd.CommandText = "SELECT * FROM [" & NomFeuille & "$" & Cellule & "]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
Rst(0).Value = tablo(i)
Rst.Update
Next i
Cn.Close
Set Cn = Nothing
Set Cd = Nothing
Set Rst = Nothing
[K5] = NumeroDevis
[L5] = tablo(2)
End Sub |
Partager