Discussion :

[charlesj]

Bonjour,

Je me permets de vous contacter car je suis dans la panade. Après plusieurs recherches je n'arrive pas à résoudre mon problème.
Voilà, ma macro me copie-colle un tableau d'un document excel à un autre et je souhaite transformer des nombres (stockés sous format texte) en format nombre. J'ai donc utilisé Cdbl(). Mais j'ai une erreur d’exécution 13 : incompatibilité de type. et là je suis complètement bloqué.

Pouvez vous m'aider??

Merci d'avance

Je vous montre ma macro :

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
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
Public Namepatch3 As String

Public Const OBSBase_NumLigDeb As Integer = 4

Public Const OBSBases_NumLigDeb As Integer = 5

Public Const OBSBase_NumColCodeProjet As Integer = 3
Public Const OBSBase_NumColLast As Integer = 18

Public Const Appli_NumLigMax As Long = 200000

Sub Upload_Cartouche_OBS()
' Cette procédure a pour but d'importer le BM view en gardant la mise en page

    Application.Calculation = xlManual
    
    Set FranceFe = ThisWorkbook.Worksheets("France")
        
    
    Repertoire = ThisWorkbook.Path
    Nom_Fichier = ThisWorkbook.Name
    OBSview_NumLig = OBSview_NumLigDeb
    j = 3
    
    'FranceFe(1, 1).Value = Repertoire
    'FranceFe.Cells(2, 1).Value = OBSview_NumLig
    'FranceFe.Cells(3, 1).Value = CRA_NumLig
    
    Application.EnableEvents = False
    Application.DisplayAlerts = False
   
    ' Suppression des lignes du Details
   Worksheets("France").Range("A8:H16").ClearContents
    
    ' balayage de tous les fichiers du répertoire
    FichS = Dir(Repertoire & "\*.xls*")
    While ((FichS <> "") And (Left(FichS, 1) <> "~"))
        j = j + 1
        'France.Cells(j, 1).Value = FichS
        
        If (FichS = Nom_Fichier) Then
            FichS = Dir
        Else
            FichS_nom_complet = Repertoire & "\" & FichS
            Workbooks.Open FichS_nom_complet

  
      
      Dim i As Integer
                
            For i = 1 To Worksheets.Count
            nom_feuille = Worksheets(i).Name
                If (Left(nom_feuille, 8) = "Coop OBS") Then
                    OBSBase_NumLig = OBSBase_NumLigDeb
                    While (Worksheets(i).Cells(OBSBase_NumLig, OBSBase_NumColCodeProjet) <> "")
                        OBSBase_NumLig = OBSBase_NumLig + 1
                    Wend
                    
                     Worksheets(i).Range("A3:H11").Select
                    Selection.Copy
                    FranceFe.Activate
                    Worksheets("France").Range("A8:H16").Select
                    ActiveSheet.Paste
                    OBSview_NumLig = OBSview_NumLig + OBSBase_NumLig - OBSBase_NumLigDeb
                
                    'enlève le K€ des cellules C9:H11 de la cartouche
                    Worksheets("France").Range("C9:H11").Select
                    Selection.Replace What:=" k€", Replacement:="", LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, MatchCase:=False
                    
                                       
                    'enlève le K€ des cellules C13:H13 de la cartouche
                    Worksheets("France").Range("C13:H13").Select
                    Selection.Replace What:=" k€", Replacement:="", LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, MatchCase:=False
                                  
                    'enlève le K€ des cellules C15:H15 de la cartouche
                    Worksheets("France").Range("C15:H15").Select
                    Selection.Replace What:=" k€", Replacement:="", LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, MatchCase:=False
                                  
'Equivalent cnum

' Erreur 13
'                        Worksheets("France").Range("C8:H16").Select
'                        For Each cell In Selection
'                        If Application.IsText(cell.Value) Then
'                        cell.Value = CDbl(cell.Value)
'                        End If
'                        Next

' Autre essai équivalent cnum
                        For Each cell In Range("C8:H16")
                        cell = CDbl(cell)                                    'l'erreur apparaît ICI
                        Next cell
                    
                    'Fromat %
                    Worksheets("France").Range("C12").Select
                    Selection.NumberFormat = "0.00%"
                    Worksheets("France").Range("C14").Select
                    Selection.NumberFormat = "0.00%"
                    Worksheets("France").Range("C16").Select
                    Selection.NumberFormat = "0.00%"
                    Worksheets("France").Range("D12").Select
                    Selection.NumberFormat = "0.00%"
                                  
                End If
            Next i
            Workbooks(FichS).Close
            FichS = Dir
               
        End If
    Wend
    
    Application.EnableEvents = True
    Application.DisplayAlerts = True


Application.Calculation = xlAutomatic

End Sub

[Gado2600]

Bonjour,

As-tu regardé si cela plante sur une ligne en particulier ou sur plusieurs (ou même la globalité) ?

Cordialement,

[charlesj]

Merci de ta réponse rapide,

En fait j'avais oublier de retirer le texte dans certaines cellules. Comme pour celles où je retire le K€ il fallait que je retire la suite de caractère, se qui donne :

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
 
 
 
                    'enlève le K€ des cellules C9:H11 de la cartouche
                    Worksheets("France").Range("C9:H11").Select
                    Selection.Replace What:=" k€", Replacement:="", LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, MatchCase:=False
 
                    'enlève le texte1 des cellules D8, F8 de la cartouche
                    Worksheets("France").Range("D8", "F8").Select
                    Selection.Replace What:=" texte1", Replacement:="", LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, MatchCase:=False
 
                    'enlève le texte2 des cellules C8, H8 de la cartouche
                    Worksheets("France").Range("C8", "H8").Select
                    Selection.Replace What:=" texte2", Replacement:="", LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, MatchCase:=False
 
                    'enlève le K€ des cellules C13:H13 de la cartouche
                    Worksheets("France").Range("C13:H13").Select
                    Selection.Replace What:=" k€", Replacement:="", LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, MatchCase:=False
 
                    'enlève le K€ des cellules C15:H15 de la cartouche
                    Worksheets("France").Range("C15:H15").Select
                    Selection.Replace What:=" k€", Replacement:="", LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, MatchCase:=False
 
                    'Equivalent cnum
 
                        Worksheets("France").Range("C8:H16").Select
                        For Each cell In Selection
                        If Application.IsText(cell.Value) Then
                        cell.Value = CDbl(cell.Value)
                        End If
                        Next
 
 
                    'Ré-application d'un Fromat %
                    Worksheets("France").Range("C12").Select
                    Selection.NumberFormat = "0.00%"
                    Worksheets("France").Range("C14").Select
                    Selection.NumberFormat = "0.00%"
                    Worksheets("France").Range("C16").Select
                    Selection.NumberFormat = "0.00%"
                    Worksheets("France").Range("D12").Select
                    Selection.NumberFormat = "0.00%"