Effectivement, dans une autre application,Un problème grave peut se produire si une colonne contient à la fois des valeurs numériques et du texte.
site:developpez.net Ado +Excel 8.0;IMEX=1
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Worksheets("ABONNES").Select
ActiveSheet.UsedRange.Select
Dim CELLULE As Range
For Each CELLULE In Selection
If Left(CELLULE, 1) <> "¥" Then
CELLULE = "¥" & CELLULE
End If
Next
ActiveWorkbook.Save
End Sub
Sub ENREGISTRER()
'(A ne pas oublier de cocher "Microsoft ADO Ext. 2.7 for DDL and Sécurity dans les Références)
Dim Cn As ADODB.Connection
Dim Cd As ADODB.Command
Dim Rst As ADODB.Recordset
Dim Fichier As String
Fichier = ThisWorkbook.Path & "\DONNEES_2.xls"
Set Cn = New ADODB.Connection
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;HDR=No;"";"
Set Cd = New ADODB.Command
Cd.ActiveConnection = Cn
Cd.CommandText = "SELECT * FROM [Feuil1$A1:A1]"
Set Rst = New ADODB.Recordset
Rst.Open Cd, , adOpenKeyset, adLockOptimistic
Rst(0).Value = "¥" & UserForm1.TextBox1.Text
Rst.Update
Cn.Close
Set Cn = Nothing
Set Cd = Nothing
Set Rst = Nothing
End Sub
Sub TRANSFERER_VERS_BASE_DE_DONNEES() 'La référence "Microsoft ActiveX Data Object 2.x Library" doit être cochée!
Dim APPEL As New ADODB.Connection
Dim ENREGISTREMENT As New ADODB.Recordset, FEUILLE As ADODB.Recordset
Dim ECOUTE As ADODB.Connection, j As Integer
Dim CLASSEUR_CIBLE As String, CLASSEUR_SOURCE As String
CLASSEUR_CIBLE = ThisWorkbook.Path & "\BASE.xls" 'On pourrait remplacer par une Recherche du Classeur!
CLASSEUR_SOURCE = ActiveWorkbook.FullName
'------------------------------------------------------------------
APPEL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CLASSEUR_SOURCE & ";" & "Extended Properties=""Excel 8.0;HDR=NO;"""
ENREGISTREMENT.Open "SELECT * FROM [TRANSFERT$]", APPEL, adOpenStatic 'FEUILLE A POMPER
'------------------------------------------------------------------
Set ECOUTE = New ADODB.Connection
ECOUTE.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CLASSEUR_CIBLE & ";" & "Extended Properties=""Excel 8.0;HDR=NO;"""
Set FEUILLE = New ADODB.Recordset
FEUILLE.Open "Select * from [RECEPTION$]", ECOUTE, adOpenKeyset, adLockOptimistic ' FEUILLE DE DESTINATION
'------------------------------------------------------------------
Do While Not (ENREGISTREMENT.EOF) 'ON PROCEDE A L'ECRITURE
FEUILLE.AddNew
For j = 0 To FEUILLE.Fields.Count - 1
FEUILLE.Fields(j) = ENREGISTREMENT.Fields(j).Value
Next j
FEUILLE.Update
ENREGISTREMENT.MoveNext
Loop
ENREGISTREMENT.Close: APPEL.Close: FEUILLE.Close: ECOUTE.Close
End Sub
Do While Not (ENREGISTREMENT.EOF) 'ON PROCEDE A L'ECRITURE
FEUILLE.AddNew
For j = 0 To FEUILLE.Fields.Count - 1
FEUILLE.Fields(j) = ENREGISTREMENT.Fields(j).Value
Next j
FEUILLE.Update
ENREGISTREMENT.MoveNext
Loop
With CONNEXION
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & CLASSEUR_A_FOUILLER & ";Extended Properties=""Excel 8.0;IMEX=1"""
.Open
End With
Pour le reste, je n'ai pas le courage de lire toute cette littérature.