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 |
Partager