Discussion :

[lemisentrope]

Bonjour à vous,

(encore moi je sais ...)

J'ai un problème sur mon tri de cellule, il fonctionne mais il démarre mal et je ne comprends pas pourquoi...
Je vous explique la situation, il s'agit d'une application calculant à partir des données insérées par l'utilisateur des longueurs et etc... Ici en l’occurrence, l'utilisateur lambda insère son fichier .obj et ma procédure traite ce fichier .obj en dissociant les valeurs et etc... Ce que je cherche à faire, c'est isoler les premières valeurs associées à la ligne de "f", je vous explique en images si vous le permettez :

A la base le fichier ressemble à ça :


Ensuite grâce à une procédure (que je vous présente après), il ressort comme ça :



Comme vous pouvez le voir, il apparaît 2 fois la ligne (sur le screenshot), en réalité il apparaît 5 fois... Et de plus quand les valeurs changent (quand ce n'est plus 1 2 3 4), j'ai des lignes de "f" qui sont passées à la trappe ... Et après ça, ça reprend normal, mais il y a un décalage au niveau de la 4ème valeur associée à "f"

Voici ma procédure :

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
 
Sub test()
'
'
' only obj file from sketchup
'
'
 
Worksheets.Add
Worksheets(1).Activate
 
Dim strTemp As String
Dim MyDataObject As DataObject  
 
Dim i, j As Integer
Dim face As String
Dim TextPart As String
 
Dim FileName As Variant
 
 '
 ' import obj file
 '
 
  FileName = Application.GetOpenFilename("OBJ File (*.obj),*.obj,", 1, "Select an obj file from SketchUp to Import")
 
             Open FileName For Binary As #1
 
        If FileName = False Then
            MsgBox ("No file was selected.")
        Else
            ans = MsgBox("You selected and Obj file from SketchUp : " & FileName _
            & "                                                                                                      Continue ?", vbOKCancel)
                If ans = vbOK Then GoTo NextStep
                If ans = vbCancel Then Exit Sub              
        End If
 
NextStep:
 
 
    strTemp = Space$(LOF(1))
    Get #1, , strTemp
 
    strTemp = Replace(strTemp, " ", vbTab)
 
    Set MyDataObject = New DataObject
    MyDataObject.SetText strTemp
    MyDataObject.PutInClipboard
    Range("A1").PasteSpecial
 
    Close #1
 
    MyDataObject.Clear
    Set MyDataObject = Nothing
 
                        '
                        ' adaptation obj file - extracting face
                        '   
 
                      lastline = Range("A65536").End(xlUp).Row
 
                    Do While ActiveCell.Row < lastline + 1
 
                        If ActiveCell.Value = "f" Then
 
                            For j = 1 To 4
 
                                If ActiveCell.Offset(0, j) <> Empty Then
 
                                        face = ActiveCell.Offset(0, j).Value
                                        TextPart = ""
 
                                        For i = 1 To Len(face)
                                            If IsNumeric(Mid(face, i, 1)) Then
                                                TextPart = TextPart & Mid(face, i, 1)
                                            Else
                                                Exit For
                                            End If
                                        Next i
 
                                    ActiveCell.Offset(0, j).Value = TextPart
 
                                End If
                            Next j
                          End If
 
                        ActiveCell.Offset(1, 0).Select
                       Loop
 
  Cells.NumberFormat = "@"      'passage en format général car Excel est par défaut en mode date et c'est le bordel...
 
End Sub

Veuillez trouver ci-joint le fichier .obj en question.
test_hemisphere_sketchup.zip


Quelqu'un aurait une solution à cette erreur ? Je soupçonne que le format "date" est complice dans cette affaire, faudrait il que je fasse le tri tant que je suis dans le clipboard ? Si oui, comment ?

Merci à vous

NB : Je remercie parmi pour le code qui permet de séparer les cellules.