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
| Sub exporter()
' EXPORTATION DANS ACCESS de CHANGEMENTs DE VALEURS DE CHAMPS
Dim source As database
Dim t_list As Recordset
Dim chemin As String, nouvgrp As String
Dim nbre As Long, numero As Long, lig As Long
ActiveSheet.Unprotect
Application.ScreenUpdating = False
chemin = ActiveWorkbook.Path
'ouvre la base de données demo
Set source = dbengine.opendatabase(chemin & "\bdjuin.mdb")
'ouvre la table générale
Set t_list = source.OpenRecordset("Armoire", dbopendynaset)
nbre = Application.CountA(Range("K1:K24"))
lig = 3
While lig <= nbre
numero = Cells(lig, 11)
nouvgrp = Cells(lig, 12)
With t_list
.MoveFirst
'recherche la fiche concernée
.FindFirst ("num=" & (numero))
' exclusion si numéro de fiche inconnu
If .NoMatch Then
MsgBox "valeur " & numero & " inconnue"
' selon appli sortie ou continuer vbyesno?
'ActiveSheet.Protect
t_list.Close
source.Close
Exit Sub
Else
' inscrit les changements
.Edit
.Fields("grp") = nouvgrp
.Update
End If
End With
lig = lig + 1
Wend
'ActiveSheet.Protect
t_list.Close
source.Close
End Sub |
Partager