Bonjour,

Je suis face à un petit problème qui est entrain de me faire perdre un temps fou.
VBA me retourne une erreur d'incompatibilité de type, à la ligne:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
Lig = Rng.Find(Texte, Cells(Lig, Rng.Column), xlValues).Row
De mon code:

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Option Compare Database
 
Sub ReadData()
    Dim i As Long, j As Long, t As Integer
    Dim val, OF As String
    Dim xls As Excel.Application
    Dim CarteDuPanneau As Integer
    Dim Composant, Boitier, TypeFenetre, NFenetre, TypeErreur, Operateur As String
 
DoCmd.SetWarnings False
'Ajout des données dans la base
 
PathName = "C:\Users\seyahi\Documents\Projet QUALITE\fichiers qualité\VISION\DocumentVISION\"
FileName = "ImportDonneeExt.xlsm"
Set xls = CreateObject("Excel.Application")
Set wbs = xls.Workbooks.Open(FileName:=PathName & FileName)
Set ws = wbs.Sheets("FichierAOI")
Der_ligne = ws.Cells(Rows.Count, "B").End(xlUp).Row
 
'For i = 1 To Der_ligne
'    If IsNumeric(WS.Cells(i, "A")) = True Then
'        OF = WS.Cells(i, "C").Value
'        For j = 1 To Der_ligne
'            If WS.Cells(j, 1) = "" Then
'                val = WS.Cells(j, 2).Value
'                CarteDuPanneau = Right(val, 1)
'                Composant = Left(val, 4)
'                Boitier = WS.Cells(j, 3)
'                TypeFenetre = WS.Cells(j, 4)
'                NFenetre = WS.Cells(j, 5)
'                TypeErreur = WS.Cells(j, 7)
'                Operateur = WS.Cells(j, 8)
'                DoCmd.RunSQL "INSERT INTO DATA (OF, CarteDuPanneau, Composant, Boitier, TypeFenetre, NFenetre, TypeErreur, Operateur) VALUES ('" & OF & "', '" & CarteDuPanneau & "','" & Composant & "','" & Boitier & "','" & TypeFenetre & "','" & NFenetre & "','" & TypeErreur & "','" & Operateur & "')"
'            End If
'        Next j
'    End If
'Next i
'wbs.Close
 
'------------------------------------------------------------------------
Dim x As Integer
Dim Lignes()
Dim Texte As String
Dim Plage As Range
Dim Flag As Boolean
 
Set Plage = ws.Columns(10) 'plage de recherche
Texte = "0"   'expression cherchée
Flag = Find_Next(Plage, Texte, Lignes())  'appel de la fonction
If Flag Then  'si fonction retourne Vrai = expression trouvée dans la plage
    For x = LBound(Lignes) To UBound(Lignes)   'restitution des lignes correspondantes
        Debug.Print Lignes(x, 1)
    Next x
Else
    'MsgBox "L'expression : " & Texte & " n'a pas été trouvée dans la plage : " & Plage.Address
End If
 
 
DoCmd.SetWarnings True
End Sub
Function Find_Next(Rng As Range, Texte As String, Tbl()) As Boolean
 
Dim Nbre As Integer
Dim Lig As Long, Cptr As Long
 
PathName = "C:\Users\seyahi\Documents\Projet QUALITE\fichiers qualité\VISION\DocumentVISION\"
FileName = "ImportDonneeExt.xlsm"
Set xls = CreateObject("Excel.Application")
Set wbs = xls.Workbooks.Open(FileName:=PathName & FileName)
Set ws = wbs.Sheets("FichierAOI")
Der_ligne = ws.Cells(Rows.Count, "B").End(xlUp).Row
 
    'Nbre = Application.WorksheetFunction.CountIf(Rng, Texte)
        Nbre = xls.WorksheetFunction.CountIf(ws.Range("J:J"), "0")
    If Nbre > 0 Then
        ReDim Tbl(Nbre - 1)
        Lig = 1
        For Cptr = 0 To Nbre - 1
            Lig = Rng.Find(Texte, Cells(Lig, Rng.Column), xlValues).Row
            'Lig = Rng.Find(What:=Texte, after:=ws.Cells(Lig, Rng.Column), LookIn:=xlValues).Row
            Tbl(Cptr, 1) = Lig
        Next
        Debug.Print Nbre
        Debug.Print Tbl(Cptr, 1)
    Else
        GoTo Absent
    End If
    Find_Next = True
    Exit Function
Absent:
    Find_Next = False
End Function
Peut être que vous allez pouvoir me trouver la cause de cette erreur, car moi j'ai cherché en vain.
Merci d'avance