EXCEL ADO VBA

Salut,
Voici plusieurs proc pour utiliser une base de données dans Excel. Pour
tester, crée une base de données dans la feuil1 et execute "Ajouter" pour
ajouter un enregistrement et "LireOuModifier" pour, comme son nom l'indique,
lire tout ou partie de la base et modifier un enregistrement. Il est bien
évident qu'il va falloir que tu adapte car ceci est assez simple mais cela
fonctionne sur un classeur aussi bien fermé qu'ouvert qu'il contienne ou non
les procs.

Private Sub ConnecterCLasseur(ConnectCL As Object, _
Fichier As String, _
Entete As Boolean, _
LectureSeule As Boolean, _
Optional Rs)

'avec relation tardive
Set ConnectCL = CreateObject("ADODB.Connection")
If Not IsMissing(Rs) Then
Set Rs = CreateObject("ADODB.Recordset")
End If

ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Fichier & ";" & _
"Extended Properties=""Excel 8.0;" & _
"HDR=" & IIf(Entete = True, "YES", "NO") & _
";IMEX=" & IIf(LectureSeule = True, 1, 2) & ";"""
End Sub

Sub Ajouter()
Dim Chemin As String
Dim FeuilleBDD As String
Dim FeuilleSource As String
Dim Entete As Boolean
Dim Rng As String

Chemin = "D:Classeur1.xls"

'feuille où se situe la base de donnée
FeuilleBDD = "Feuil1"
'feuille où est récupéré l'enregistrement
FeuilleSource = "Feuil3"
'défini la plage
With Worksheets(FeuilleBDD)
Rng = .Range(.Cells(1, 1), _
.Cells(.Cells.Find("*", .[A1], -4123, , 1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , 2,
2).Column)).Address(0, 0)
End With

Entete = True

AjouterEnregistrement Worksheets(FeuilleSource), Rng, Chemin, FeuilleBDD,
Entete

End Sub

Sub LireOuModifier()
Dim Tbl
Dim Chemin As String
Dim FeuilleBDD As String
Dim FeuilleCible As String
Dim Entete As Boolean
Dim ChaineSQL As String
Dim Rng As String
Dim Remplacer

Chemin = "D:Classeur1.xls"

FeuilleBDD = "Feuil1"
FeuilleCible = "Feuil2"

With Worksheets(FeuilleBDD)
Rng = .Range(.Cells(1, 1), _
.Cells(.Cells.Find("*", .[A1], -4123, , 1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , 2,
2).Column)).Address(0, 0)
End With

Entete = True

Remplacer = ""

'le signe % est un jocker qui remplace 1 ou plusieurs caractères
'le signe _ est un jocker qui remplace seulement un caractère
'les crochets [ae], avec les lettres à l'intérieur, s'utilisent
'comme le signe _ mais avec les lettres indiquées
'Cr[oia]ps retourne Crips, Crops, Craps

ChaineSQL = "WHERE Nom LIKE '%' " 'retoure tous les enregistrements

LireModifierEnregistrement Chemin, _
FeuilleBDD, _
Rng, _
ChaineSQL, _
Entete, _
Tbl _
', Remplacer, _
'"Nom"

On Error Resume Next
If Remplacer = "" Then
With ThisWorkbook.Worksheets(FeuilleCible)
If Range(Rng).Cells.Count > 1 Then
.Range(.[A1], .Cells(UBound(Tbl, 1), _
UBound(Tbl, 2))).Value = Tbl
Else
.Range("A1").Value = Tbl(1)
End If
End With
Erase Tbl
End If

End Sub

Sub AjouterEnregistrement(FeuilleSource As Worksheet, _
Plage As String, _
CheminClasseurCible As String, _
NomFeuille As String, _
Entete As Boolean)

Dim ConnectCL As Object
Dim Rs As Object
Dim Co_Plage As Range
Dim ChaineSQL As String
Dim I As Integer, J As Integer

'effectue un contrôle de validité
If Controle(CheminClasseurCible, Plage) = False Then Exit Sub
'si la plage est une cellule seule, "A1" la transforme
'en "A1:A1"
If InStr(Plage, ":") = 0 Then Plage = Plage & ":" & Plage
'défini la plage dans un range
Set Co_Plage = FeuilleSource.Range(Plage)
'ouvre la connection au classeur
ConnecterCLasseur ConnectCL, CheminClasseurCible, Entete, False, Rs
'ouvre le jeu d'enregistrement et ajoute les valeurs
With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$`", ConnectCL
For I = 1 To Co_Plage.Rows.Count
.AddNew
For J = 1 To Co_Plage.Columns.Count
.Fields(J - 1) = Co_Plage(I, J)
Next J
.Update
Next I
End With

ConnectCL.Close

Set Co_Plage = Nothing
Set Rs = Nothing
Set ConnectCL = Nothing
Set FeuilleSource = Nothing
End Sub

Sub LireModifierEnregistrement(CheminClasseurCible As String, _
NomFeuille As String, _
Plage As String, _
ChaineSQL As String, _
Entete As Boolean, _
TableauRetour, _
Optional Remplacer, _
Optional NomChamp)

Dim ConnectCL As Object
Dim Rs As Object
Dim Champ As Object
Dim I As Integer, J As Integer

'effectue un contrôle de validité
If Controle(CheminClasseurCible, Plage) = False Then Exit Sub
'si la plage est une cellule seule, "A1" la transforme
'en "A1:A1"
If InStr(Plage, ":") = 0 Then Plage = Plage & ":" & Plage

'ouvre la connection au classeur
ConnecterCLasseur ConnectCL, CheminClasseurCible, Entete, False, Rs
'ouvre le jeu d'enregistrement pour effectuer la recherche

With Rs
.CursorType = 1
.LockType = 3
.Open "SELECT * FROM `" & NomFeuille & "$" & _
Plage & "` " & ChaineSQL, ConnectCL

If .RecordCount = 0 Then
MsgBox "Ancun enregistrement trouvé !"
Exit Sub
End If

.MoveFirst
'effectue la modif si les valeurs ont été passées en paramètre
'sinon retourne les enregistrements trouvés dans le tableau
If Not IsMissing(Remplacer) And Not IsMissing(NomChamp) Then
If MsgBox("Modifier les enregistrements ?", _
vbYesNo + vbQuestion) = vbNo Then Exit Sub
Do While Not .EOF
.Fields(NomChamp).Value = Remplacer
.Update
.MoveNext
Loop
Else
If Range(Plage).Cells.Count > 1 Then
ReDim TableauRetour( _
1 To .RecordCount, _
1 To .Fields.Count)
.MoveFirst
Do While Not .EOF
I = I + 1
For Each Champ In .Fields
J = J + 1
TableauRetour(I, J) = Champ.Value
Next
J = 0
.MoveNext
Loop
Else
ReDim TableauRetour(1 To 1)
TableauRetour(1) = .Fields(0).Value
End If
End If
End With

ConnectCL.Close

Set Rs = Nothing
Set ConnectCL = Nothing
End Sub

Private Function Controle(CheminCible As String, _
Plage As String) As Boolean
Dim Factice As Range
'effectue un contrôle de validité de la plage
Controle = True

If Plage = "" Then
MsgBox "La plage passée en argument est vide !"
Controle = False
Exit Function
End If

If Dir(CheminCible) = "" Then
MsgBox "Le fichier '" & CheminCible & "' est introuvable !"
Controle = False
Exit Function
End If

If InStr(Plage, ";") <> 0 Then
MsgBox "La plage doit être contiguë !"
Controle = False
Exit Function
End If

On Error Resume Next
Set Factice = Range(Plage)
If Err.Number <> 0 Then
MsgBox "Erreur dans l'orthographe de la plage !" _
& vbCrLf & "Plage non valide > " & Plage
Controle = False
End If
Set Factice = Nothing
On Error GoTo 0

End Function

Salutations.
Hervé.

<anonymous@discussions.microsoft.com> a écrit dans le message de news:
114601c46ef7$a5d90fe0$a601280a@phx.gbl...
J'ai d'abord essayé d'interroger un classeur excel avec
ADO dans ce propre classeur, j' ai eu des bugs et en est
tiré la conclusion que c'est pas possible.
(si qqun sait faire)

J'ai donc séparé les choses , un fichier excel pour la
macro ADO
un autre fichier excel pour la base de donnée.

maintenant mon pb est que lorsque la macro est en
execution
si un autre utilisateur souhaite ouvrir le fichier excel
base de donnée

"impossible d' accéder au fichier bdd.xls "