Nombre stocké sous forme de texte

**Excel_man** · 01/12/2013, 20h52

Bonjour,
J'ai passé plusieurs heures chercher comment lire des données dans un classeur fermé et a chaque fois soit la routine était très longue a s’exécuter soit je n'arrivé pas a adapter le code a mon cas. Finalement, c'est sur la page de Ron de Bruin: http://www.rondebruin.nl/win/s3/win024.htm que j'ai fini par trouvé mon bonheur.
Enfin, c'est ce que que je croyais jusqu’à’à ce que me rende compté que les nombres stockés sous forme de texte, ce qui bloque certaines formules.
Quelqu’un connait-il cette macro o une façon de de remettre sous forme de nombre mes infos?
Merci

**Daniel.C** · 01/12/2013, 21h23

Bonjour,

Poste plutôt ton code que ceux de la page de Ron deBruin.

**Excel_man** · 01/12/2013, 21h31

Voici la fonction que l'on appel par :
GetData Range("Chemin").Value & Range("Fichier").Value, "CONFIG", "B14:B25", Sheets("CONFIG").Range("B14"), False, False
Les options a la fin (False, False) servent a definir si la plage comporte une entête.

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
Option Explicit
 
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long
 
    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If
 
    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If
 
    On Error GoTo SomethingWrong
 
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")
 
    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
 
    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then
 
        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
            End If
        End If
 
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If
 
    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub
 
SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0
 
End Sub
 
Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 
Function Array_Sort(ArrayList As Variant) As Variant
    Dim aCnt As Integer, bCnt As Integer
    Dim tempStr As String
 
    For aCnt = LBound(ArrayList) To UBound(ArrayList) - 1
        For bCnt = aCnt + 1 To UBound(ArrayList)
            If ArrayList(aCnt) > ArrayList(bCnt) Then
                tempStr = ArrayList(bCnt)
                ArrayList(bCnt) = ArrayList(aCnt)
                ArrayList(aCnt) = tempStr
            End If
        Next bCnt
    Next aCnt
    Array_Sort = ArrayList
End Function

**EngueEngue** · 02/12/2013, 09h18

utilise :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

cdbl(cequetuveuxconvertirennombre)

**Daniel.C** · 02/12/2013, 10h37

Bonjour,

Nulle part, dans le code que tu as publié la variable "TargetRange" n'est définie
Essaie de modifier comme ceci :

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
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)
' 30-Dec-2007, working in Excel 2000-2007
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim lCount As Long
 
    ' Create the connection string.
    If Header = False Then
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=No"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=No"";"
        End If
    Else
        If Val(Application.Version) < 12 Then
            szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 8.0;HDR=Yes"";"
        Else
            szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                        "Data Source=" & SourceFile & ";" & _
                        "Extended Properties=""Excel 12.0;HDR=Yes"";"
        End If
    End If
 
    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If
 
    On Error GoTo SomethingWrong
 
    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")
 
    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1
 
    ' Check to make sure we received data and copy the data
    If Not rsData.EOF Then
 
        If Header = False Then
            TargetRange.Cells(1, 1).CopyFromRecordset rsData
            Numérique (TargetRange)
        Else
            'Add the header cell in each column if the last argument is True
            If UseHeaderRow Then
                For lCount = 0 To rsData.Fields.Count - 1
                    TargetRange.Cells(1, 1 + lCount).Value = _
                    rsData.Fields(lCount).Name
                Next lCount
                TargetRange.Cells(2, 1).CopyFromRecordset rsData
                Numérique (TargetRange)
            Else
                TargetRange.Cells(1, 1).CopyFromRecordset rsData
                Numérique (TargetRange)
            End If
        End If
 
    Else
        MsgBox "No records returned from : " & SourceFile, vbCritical
    End If
 
    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Sub
 
SomethingWrong:
    MsgBox "The file name, Sheet name or Range is invalid of : " & SourceFile, _
           vbExclamation, "Error"
    On Error GoTo 0
 
End Sub

et ajoute :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Numérique(TargetRange)
    Dim C As Range
    For Each C In TargetRange
        If IsNumeric(C) Then
            C.NumberFormat = "General"
            C.Value = CDbl(C.Value)
        End If
    Next C
End Sub

**Excel_man** · 02/12/2013, 11h39

Bonjour,
Merci pour vos réponse. J'ai d'abord essayé, comme me la proposé EngueEngue un Cdbl en bouclant sur chaque cellule de ma plage avec un test IsNumeric et ca marche mais c'est très long a s’exécuter.

Et je viens maintenant d'essayer la proposition de Daniel et ça plante dans le Sub Numeric. Aprés la ligne "For Each...", j'ai une erreur 424:"Objet requis"
Par contre j'ai vu que la variable TargetRange est définie comme un Range comme paramètre de la fonction.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Public Sub GetData(SourceFile As Variant, SourceSheet As String, _
                   SourceRange As String, TargetRange As Range, Header As Boolean, UseHeaderRow As Boolean)

Nombre stocké sous forme de texte [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager