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)

**Daniel.C** · 02/12/2013, 13h17

Oui, il faut lui passer la plage TableRange en paramètre. Sinon le principe est celui de "EngueEngue".

Par contre j'ai vu que la variable TargetRange est définie comme un Range comme paramètre de la fonction.

Oui mais qu'est-ce que tu passes comme paramètre quand tu appelles la fonction GetData ?

Invité · 02/12/2013, 13h41

fais ta conversion dans ta requête.

Code :

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

Sql="Select CDbl([MyNum]) as MonNombre ,....

**Excel_man** · 02/12/2013, 23h38

Bonsoir,
Daniel,
Les paramètres pour appeler la fonction sont dans l'ordre:
- Le répertoire du fichier fermé & le nom du fichier fermé
- Le nom de la feuille du fichier fermé (dans mon exemple, l'onglet source et destination ont le même nom)
- La plage des cellules contiguës a lire dans fichier fermé
- La cellule de mon fichier a partir de la quelle je colle la plage copiée
- Les 2 "false" correspondent a des options sur les entêtes (existant? a recopier?)

Code :

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

GetData Range("Chemin").Value & Range("Fichier").Value, "CONFIG", "B14:B25", Sheets("CONFIG").Range("B14"), False, False

Robert,
Sql="Select CDbl([MyNum]) as MonNombre ,.... moi pas comprendre

Ce code n'est pas de moi

, et je n'en saisie pas tout le sens notamment ce Sql....
Tu termine par .... Est-ce que je suis sensé finir ta phrase? Si oui, RDV dans plusieurs mois.
Merci quand même.

Invité · 03/12/2013, 09h50

Envoyé par Excel_man

Bonsoir,
Robert,
Sql="Select CDbl([MyNum]) as MonNombre ,.... moi pas comprendre

Ce code n'est pas de moi

, et je n'en saisie pas tout le sens notamment ce Sql....
Tu termine par .... Est-ce que je suis sensé finir ta phrase? Si oui, RDV dans plusieurs mois.
Merci quand même.

effectivement:

Code :

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

szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"

ceci est mon code; pas besoin de traitement supplémentaire. la mise en forme ce fait dans la requête.

Code :

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

1
2
3
 szSQL = "SELECT cdbl([Champ1]) ,[Champ2] FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
...
TargetRange.Cells(1, 1).CopyFromRecordset rsData

tu es sensé connaitre ta requête! je suis d'accord RDV dans plusieurs mois, voir jamais!

**Daniel.C** · 03/12/2013, 10h56

Bonjour,

A rdurupt :

Apparemment, il s'agit d'une requête sur une plage Excel sans entêtes.

A Excel_man:

Remplace les 3 :

Code :

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

Numérique (TargetRange)

par :

Code :

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

Numérique(SourceRange, TargetRange)

et la macro "Numérique devient :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub Numérique(SourceRange, TargetRange)
    Dim C As Range, Plage As Range
    With Range(SourceRange)
        Set Plage = TargetRange.Resize(.Rows.Count, .Columns.Count)
    End With
    For Each C In TargetRange
        If IsNumeric(C) Then
            C.NumberFormat = "General"
            C.Value = CDbl(C.Value)
        End If
    Next C
End Sub

D'une manière générale, tu as un très bon tutoriel en français ici :

http://silkyroad.developpez.com/VBA/ClasseursFermes/

Invité · 03/12/2013, 11h09

Code :

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

debug.print rsData(0).name

tu verras que tous le champs ont une entête par défaut.

**Daniel.C** · 03/12/2013, 11h41

Je mourrai moins idiot ce soir

Invité · 03/12/2013, 14h48

Envoyé par Daniel.C

Je mourrai moins idiot ce soir

ou demain ça presse pas

**Daniel.C** · 03/12/2013, 14h59

**Excel_man** · 03/12/2013, 23h59

Bonsoir,
J'ai tourné le pb dans tout les sens avant de faire ce message car je sent que je vais passer pour une truffe

.
J'ai remplacé la ligne Sql... par celle de Robert et ça plante a la ligne 48:

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
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$ & "];"
        szSQL = "SELECT cdbl([Champ1]) ,[Champ2] 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 '>>>>>>>>> erreur qui renvoi vers SomethingWrong

    ' 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

En me relisant, je n'ai pas précisé que les infos que vais chercher dans le fichier fermé peuvent être des chiffres, du texte ou ds dates.

Daniel, j'ai essayé ta proposition de code mais ça ne change rien sur les nombres stockés sous forme de texte.
Merci pour le lien, je vais m'y pencher... deja j'ai lire au début qu'il fallait avoir les références Microsoft ActiveX Data Objects x.x Library que je n'ai pas et pourtant le code initiale fonctionne ??? Voila ce que j'ai d'installé:

Invité · 04/12/2013, 09h22

Code :

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

szSQL = "SELECT [F1],[F2] ...FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"

Envoyé par rdurupt

Code :

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

debug.print rsData(0).name

tu verras que tous le champs ont une entête par défaut.

**Excel_man** · 04/12/2013, 23h25

Merci tout de même, Robert pour ce nouvelle essai mais ça plante de la même manière (ligne 48) avec une erreur: Erreur de syntaxe dans l'expression "[F2]..".

J'ai tout de même fini par trouvé un code en fouinant sur le net, que j'utilise une fois l'import des données terminé sur ma plage de destination. Cette macro qui utilise des tableau est suffisamment rapide même si j'aurais préféré ne pas avoir a retraiter les données.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub ChgTxtToNum(MyRange As Range)
Dim var
Dim i&
Dim j&
var = MyRange
For i& = 1 To UBound(var, 1)
  For j& = 1 To UBound(var, 2)
    If IsNumeric(var(i&, j&)) Then
      var(i&, j&) = CDbl(var(i&, j&))
    End If
  Next j&
Next i&
MyRange = var
End Sub

Merci

Invité · 04/12/2013, 23h34

les ... sont pour te dire de finir la requête:

Code :

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

szSQL = "SELECT [F1],[F2],[F3] FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"

[F4],...,...,[F7] autant que tu as de champs!

Code :

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

szSQL = "SELECT [F1],cdbl([F2]),format([F3] ,'YYYY-MM-DD HH:MM:SS') as MaDate FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"

tu peux formater toutes tes données.
fais déjè ce test:

Code :

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

szSQL = "SELECT [F1],[F2],[F3] FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"

attention, si tu n'as que 2 champs pas de [F3], un champ [F°] par nombre de champs si tu as 5 champs [F de 1 à 5].

le [F] représente les colonnes de ton tableau EXCEL.

[F1] colonne 1, [F2] colonne 2 Etc...

**Excel_man** · 05/12/2013, 11h01

Bonjour,
Effectivement c'est mieux ainsi. Par contre je peux avoir 53 champs (colonnes correspondant au n° de semaine) comme 1 seul (liste de nom) car cette fonction me sert a récupérer différentes infos qui n'ont pas la même pagination. De plus dans les 53 colonnes, je peux soit avoir du texte ou des chiffres. Si je comprend bien, si je formate la requête SQL, je serais contraint de toujours l'utilisé dans les même condition?
En tout cas j'aurais appris quelques chose qui pourrait bien me resservir! Merci.

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

Macros et VBA Excel

Discussions similaires

Partager

Partager