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
| 'Ecrit les données dans le fichier Source
Sub ExporterDonnees(NomFichier As String, Feuille As String, Cellule As String, LigneEnCours As Variant, derLigne As Long)
Dim rs As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim ADOCommand As ADODB.Command
Dim repertoire As String, i As Long, j As Long
Dim Champ As Variant, Donnee As Range
Dim indexChampRef As Long, IndexChampCle As Long
Dim CouleurLigne As Long, Champ2() As Variant
Dim RefOffre As String, VersionOffre As String, Cpt As Long
Champ = Split(LISTE_DES_CHAMPS, ";", , vbBinaryCompare)
' Ouvre la connexion vers le fichier
Set cnn = New ADODB.Connection
With cnn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
& NomFichier & ";" & "Extended Properties=""Excel 12.0;HDR=YES"";"
.Open
End With
' Ouvre un Recordset contenant les données de la feuille
Set rs = New ADODB.Recordset
rs.Open "SELECT * from `" & Feuille & Cellule & "`", cnn, adOpenKeyset, adLockOptimistic
' On se positionne sur le premier enregistrement
rs.MoveFirst
For i = 0 To UBound(LigneEnCours, 3)
Cpt = 0
RefOffre = LigneEnCours(1, 0, i): VersionOffre = LigneEnCours(2, 0, i)
Do Until (rs.EOF Or rs.BOF) Or rs(indexChampRef) = RefOffre And rs(IndexChampCle) = VersionOffre
rs.MoveNext
Loop
For j = 0 To UBound(Champ) Step 2
Set Donnee = SearchString(Range("A14:T14"), Champ(j))
If Not Donnee Is Nothing Then
' Mise à jour de la ligne
If rs.Fields(Val(Champ(j + 1) - 1)).Name <> NOM_SemaineReporting And _
rs.Fields(Val(Champ(j + 1) - 1)).Name <> NOM_AvancementReporting Then
rs.Fields(Val(Champ(j + 1) - 1)).value = LigneEnCours(Cpt, 0, i)
rs.Update
Cpt = Cpt + 1
Else
Cpt = Cpt + 1
End If
End If
Next j
rs.MoveFirst
Next i
rs.Update
' Ferme la connexion
rs.Close
cnn.Close
Set cnn = Nothing
Set rs = Nothing
end sub() |
Partager