Bonjour,

Pour résumé je réaliser un modèle word sous vba.

Ce modèle permet de faire des compte rendu d'expertise

Lors de l'enregistrement de mon fichier word rempli j'utilise un répertoire excel afin de pouvoir enregistrer des donées utiles et faciliter la recherche des fichiers.

Ainsi j'utilise la méthode find afin de m'assurer avant l'enregistrement qu'il n'y a pas de numéro de rapport déjà existant (Chaque rapport à un numéro unique)

Cependant quand je fais un test vérifiant que mon fichier ne s'enregistre pas quand il y a un doublons au niveau du numéro unique j'ai l'erreur suivante qui apparait :

erreur d'exécution 13 Incompatibilité de type sur la ligne suivante

Code : Sélectionner tout - Visualiser dans une fenêtre à part
 Set TrouveRMA = .Cells.Find(what:=RMA_Cherche, LookAt:=xlPart)
Voici la partie du code correspondante

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
Dim TrouveRMA As Range
Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.Visible = True
Dim strWorkbookName  As String
strWorkbookName = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\CRE.xls"
Dim xlBook As Excel.Workbook
Set xlBook = xlApp.Workbooks.Open(FileName:=strWorkbookName)
Dim xlSheet As Excel.Worksheet
Set xlSheet = xlBook.Sheets("Feuil1")
Dim derniereligne As Long, nouvellelign  As Long
Dim RMA_Cherche As String
Dim Incrementation As Variant
RMA_Cherche = NumRMAbox.Text
 
 
With xlSheet.Range("E:E")
 
    Set TrouveRMA = .Cells.Find(what:=RMA_Cherche, LookAt:=xlPart)
    If TrouveRMA Is Nothing Then
 
        derniereligne = xlSheet.Range("C" & xlSheet.Rows.Count).End(xlUp).Row + 1
        xlSheet.Cells(derniereligne, 1).Value = DeptReparation
        xlSheet.Cells(derniereligne, 3).Value = PN & "-" & SN
        xlSheet.Cells(derniereligne, 5).Value = NumRMA
        xlSheet.Cells(derniereligne, 4).Value = WHO
 
        derniereligne = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row
        nouvelleligne = xlSheet.Range("B" & xlSheet.Rows.Count).End(xlUp).Row + 1
        Incrementation = xlSheet.Cells(derniereligne, 2).Value
 
        Dim stPLettre As String 'partie inchangée du CRE
        Dim iPrecNum As Variant 'Numero précédent
 
        iPrecNum = Left(Incrementation, 4) 'Extraction Numéro..
        xlSheet.Cells(nouvelleligne, 2).Value = Format(iPrecNum + 1, "0000") & "-" & DeptReparation & "-" & PN & "-" & SN & "-" & OF
 
 
        For Each controle In ActiveDocument.ContentControls
        If controle.Title = "NumCRE" Then
            controle.Range.Text = xlSheet.Cells(nouvelleligne, 2).Value
            numCRE = controle.Range.Text
        End If
        Next
 
        Dim strTime, chemin_F52, chemin_F54, chemin_F1, chemin_F2, chemin_F4 As String
        strTime = Format(Now, "yyyy")
        chemin_F1 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F1\"
        chemin_F2 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F2\"
        chemin_F4 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F4\"
        chemin_F52 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F52\A Valider\" & strTime & "\"
        chemin_F54 = "V:\s6_mqp\Stagiaire\Louis DONIN\F5\RMA\CRE\Nouveau dossier\F54\A Valider\" & strTime & "\"
 
 
        If DeptReparation = "F1" Then
            ActiveDocument.SaveAs FileName:=chemin_F1 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
        ElseIf DeptReparation = "F2" Then
            ActiveDocument.SaveAs FileName:=chemin_F2 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
        ElseIf DeptReparation = "F4" Then
            ActiveDocument.SaveAs FileName:=chemin_F4 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
        ElseIf DeptReparation = "F52" Then
            ActiveDocument.SaveAs FileName:=chemin_F52 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
            xlSheet.Hyperlinks.Add Anchor:=xlSheet.Cells(nouvelleligne, 2), Address:=chemin_F52 & xlSheet.Cells(nouvelleligne, 2).Value & "-" & strTime & ".xml"
        ElseIf DeptReparation = "F54" Then
            ActiveDocument.SaveAs FileName:=chemin_F54 & numCRE & "-" & strTime, FileFormat:=wdFormatFlatXMLMacroEnabled
        End If
 
        'xlBook.Save
        xlBook.Close
 
    Else
        Msgbox "Répertoire déjà rempli avec ce CRE"
        xlBook.Close
 
    End If
End With
 
Set TrouveRMA = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Ca fais trois jours que je suis bloqué la dessus merci d'avance pour toute aide proposé.

(PS lorsque le numéro RMA n'est pas dans le répertoire la macro s'exécute sans erreur)