Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Plantage sur Get en lecture sur un fichier ouvert en binary

5 réponses
Avatar
Michel Angelosanto
Bonjour,

je voudrais lire deux octets à une position précise dans un fichier que j'ai
ouvert en binary.
J'obtiens l'erreur:
"erreur d'exécution 458, Cette variable utilise un type automation non géré
par Visual basic"

Savez-vous ce que cela veut dire?
J'ai pu faire tourner le programme une fois depuis j'ai du faire une
modification inadéquate mais je ne trouve pas.
En fait le but de la manouvre est de comparer deux fichiers, peut être avez
vous un exemple tout prêt?

l'extrait du code ou ça plante:
Dim ch as string*2
ch=" "
'F nom du fichier à ouvrir
Open F For Binary As #1
seek #1,100 'on va à la position 100 dans le fichier
Get #1, , ch 'on lit 2 octets que l'on place dans ch (idem avec une
variable integer)
...
Close #1

merci pour votre aide.
--
Michel Angelosanto, Bordeaux
http://angelosa.free.fr/

5 réponses

Avatar
MichDenis
Je n'ai aucune erreur dans cette procédure :


Sub test()
Dim ch As String * 2
ch = " "
F = "c:atravailtest.txt"
Open F For Binary As #1
Seek #1, 100
Get #1, , ch
Close #1
MsgBox ch
End Sub



"Michel Angelosanto" a écrit dans le message de news:

Bonjour,

je voudrais lire deux octets à une position précise dans un fichier que j'ai
ouvert en binary.
J'obtiens l'erreur:
"erreur d'exécution 458, Cette variable utilise un type automation non géré
par Visual basic"

Savez-vous ce que cela veut dire?
J'ai pu faire tourner le programme une fois depuis j'ai du faire une
modification inadéquate mais je ne trouve pas.
En fait le but de la manouvre est de comparer deux fichiers, peut être avez
vous un exemple tout prêt?

l'extrait du code ou ça plante:
Dim ch as string*2
ch=" "
'F nom du fichier à ouvrir
Open F For Binary As #1
seek #1,100 'on va à la position 100 dans le fichier
Get #1, , ch 'on lit 2 octets que l'on place dans ch (idem avec une
variable integer)
...
Close #1

merci pour votre aide.
--
Michel Angelosanto, Bordeaux
http://angelosa.free.fr/
Avatar
MichDenis
As-tu essayé en utilisant FreeFile


Sub Test()
Dim ch As String * 2
ch = " "
No = FreeFile
F = "c:atravailtest.txt"
Open F For Binary As No
Seek No, 100
Get No, , ch
Close No1
MsgBox ch
End Sub




"MichDenis" a écrit dans le message de news:

Je n'ai aucune erreur dans cette procédure :


Sub test()
Dim ch As String * 2
ch = " "
F = "c:atravailtest.txt"
Open F For Binary As #1
Seek #1, 100
Get #1, , ch
Close #1
MsgBox ch
End Sub



"Michel Angelosanto" a écrit dans le message de news:

Bonjour,

je voudrais lire deux octets à une position précise dans un fichier que j'ai
ouvert en binary.
J'obtiens l'erreur:
"erreur d'exécution 458, Cette variable utilise un type automation non géré
par Visual basic"

Savez-vous ce que cela veut dire?
J'ai pu faire tourner le programme une fois depuis j'ai du faire une
modification inadéquate mais je ne trouve pas.
En fait le but de la manouvre est de comparer deux fichiers, peut être avez
vous un exemple tout prêt?

l'extrait du code ou ça plante:
Dim ch as string*2
ch=" "
'F nom du fichier à ouvrir
Open F For Binary As #1
seek #1,100 'on va à la position 100 dans le fichier
Get #1, , ch 'on lit 2 octets que l'on place dans ch (idem avec une
variable integer)
...
Close #1

merci pour votre aide.
--
Michel Angelosanto, Bordeaux
http://angelosa.free.fr/
Avatar
Michel Angelosanto
Voici le code complêt car c'est très bizarre je viens de changer la variable
en integer et c'est passé une fois et à la 2e fois de nouveau plantage
Le but est de supprimer les doublons dans les répertoires jpg1 et
jpg1video je fais le test sur les fichiers jpg,avi,mpg,mpeg,wmv
J'utilise la feuille courante pour stocker le nom des fichiers en colonne 1
en colonne 2 je stocke un entier lu à une position fixe de chaque fichier
puis je trie les 2 colonnes afin d'éviter la comparaison sur les fichiers
déja différents sur les 2 octets lus.

Dim t, t1, maxt, maxt1, r2, r3, temp2, temp3, zone, zone1 As Integer 'il
doit y avoir des variables inutilisées
Dim lg1, lg2 As Double

Sub doubles()
aig = 0
extension:
aig = aig + 1
Columns("A:B").Select
Selection.ClearContents
Select Case aig
Case 1:
ChDir "C:jpg1"
ext$ = "*." + "jpg"
Case 2:
ChDir "C:jpg1video"
ext$ = "*." + "mpg"
Case 3:
ChDir "C:jpg1video"
ext$ = "*." + "avi"
Case 4:
ChDir "C:jpg1video"
ext$ = "*." + "wmv"
Case Else
Exit Sub
End Select

t = 1

r$ = Dir$(ext$)
If r$ = "" Then
GoTo fin:
Else
Cells(t, 1) = r$
End If
'Lecture repertoire
While Cells(t, 1) <> ""
t = t + 1
Cells(t, 1) = Dir$
Wend
maxt = t - 1

'lecture début fichiers, on met la valeur des 2 premiers octets en colonne 2
For t = 1 To maxt
Open Cells(t, 1).Text For Binary As #2
Get #2, 50, r2
Cells(t, 2) = r2
Close #2
Next t
'on trie la liste sur la colonne 2
Range("A1:B" & maxt).Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B1:B" &
maxt) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("A1:B" & maxt)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'on supprime les doubles
For t = 1 To maxt - 1
If Cells(t, 1) = "" Then t = t + 1
Open Cells(t, 1).Text For Binary As #1
lg = LOF(1)
For t1 = 2 To maxt
If Cells(t1, 1) = "" Then t1 = t1 + 1
If Cells(t, 2) <> Cells(t1, 2) Then Exit For
'comparaison
Seek #1, 1 'on se positionne sur le premier octet
Open Cells(t1, 1).Text For Binary As #2
different = 0
If lg < LOF(2) Then lg1 = lg Else lg1 = LOF(2)
For t3 = 1 To (lg1 / 2) - 1
Get #1, , zone: Get #2, , zone1
If zone <> zone1 Then
different = 1
Exit For
End If
Next t3
Close #2
If different = 0 Then
Kill Cells(t1, 1).Text
Cells(t1, 1) = ""
End If
Next t1
Close #1
Next t
GoTo extension:

fin:
End Sub

"MichDenis" a écrit dans le message de
news:
Je n'ai aucune erreur dans cette procédure :


Sub test()
Dim ch As String * 2
ch = " "
F = "c:atravailtest.txt"
Open F For Binary As #1
Seek #1, 100
Get #1, , ch
Close #1
MsgBox ch
End Sub


Avatar
MichDenis
J'ai fait une petite boucle comme ceci et aucune erreur s'est produite :


Dim No As Long, As Integer
Dim ch As String * 2

F = "c:atravailtest.txt"

For a = 1 To 10
ch = " "
No = FreeFile
Open F For Binary As No
Seek No, 2 * a
Get No, , ch
Close No
MsgBox ch
Next

Pour ce qui est du reste, je n'ai pas l'environnement pour tester !



"Michel Angelosanto" a écrit dans le message de news:

Voici le code complêt car c'est très bizarre je viens de changer la variable
en integer et c'est passé une fois et à la 2e fois de nouveau plantage
Le but est de supprimer les doublons dans les répertoires jpg1 et
jpg1video je fais le test sur les fichiers jpg,avi,mpg,mpeg,wmv
J'utilise la feuille courante pour stocker le nom des fichiers en colonne 1
en colonne 2 je stocke un entier lu à une position fixe de chaque fichier
puis je trie les 2 colonnes afin d'éviter la comparaison sur les fichiers
déja différents sur les 2 octets lus.

Dim t, t1, maxt, maxt1, r2, r3, temp2, temp3, zone, zone1 As Integer 'il
doit y avoir des variables inutilisées
Dim lg1, lg2 As Double

Sub doubles()
aig = 0
extension:
aig = aig + 1
Columns("A:B").Select
Selection.ClearContents
Select Case aig
Case 1:
ChDir "C:jpg1"
ext$ = "*." + "jpg"
Case 2:
ChDir "C:jpg1video"
ext$ = "*." + "mpg"
Case 3:
ChDir "C:jpg1video"
ext$ = "*." + "avi"
Case 4:
ChDir "C:jpg1video"
ext$ = "*." + "wmv"
Case Else
Exit Sub
End Select

t = 1

r$ = Dir$(ext$)
If r$ = "" Then
GoTo fin:
Else
Cells(t, 1) = r$
End If
'Lecture repertoire
While Cells(t, 1) <> ""
t = t + 1
Cells(t, 1) = Dir$
Wend
maxt = t - 1

'lecture début fichiers, on met la valeur des 2 premiers octets en colonne 2
For t = 1 To maxt
Open Cells(t, 1).Text For Binary As #2
Get #2, 50, r2
Cells(t, 2) = r2
Close #2
Next t
'on trie la liste sur la colonne 2
Range("A1:B" & maxt).Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("B1:B" &
maxt) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("A1:B" & maxt)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

'on supprime les doubles
For t = 1 To maxt - 1
If Cells(t, 1) = "" Then t = t + 1
Open Cells(t, 1).Text For Binary As #1
lg = LOF(1)
For t1 = 2 To maxt
If Cells(t1, 1) = "" Then t1 = t1 + 1
If Cells(t, 2) <> Cells(t1, 2) Then Exit For
'comparaison
Seek #1, 1 'on se positionne sur le premier octet
Open Cells(t1, 1).Text For Binary As #2
different = 0
If lg < LOF(2) Then lg1 = lg Else lg1 = LOF(2)
For t3 = 1 To (lg1 / 2) - 1
Get #1, , zone: Get #2, , zone1
If zone <> zone1 Then
different = 1
Exit For
End If
Next t3
Close #2
If different = 0 Then
Kill Cells(t1, 1).Text
Cells(t1, 1) = ""
End If
Next t1
Close #1
Next t
GoTo extension:

fin:
End Sub

"MichDenis" a écrit dans le message de
news:
Je n'ai aucune erreur dans cette procédure :


Sub test()
Dim ch As String * 2
ch = " "
F = "c:atravailtest.txt"
Open F For Binary As #1
Seek #1, 100
Get #1, , ch
Close #1
MsgBox ch
End Sub


Avatar
Michel Angelosanto
Oui c'est pareil .

"MichDenis" a écrit dans le message de
news:
As-tu essayé en utilisant FreeFile


Sub Test()
Dim ch As String * 2
ch = " "
No = FreeFile
F = "c:atravailtest.txt"
Open F For Binary As No
Seek No, 100
Get No, , ch
Close No1
MsgBox ch
End Sub