Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

32587 / 76734

←次へ　｜　前へ→


	【49382】Re:shell関数で">"を使いたい。

ichinose - 07/6/3(日) 10:50 -


	引用なし

	パスワード

ダンプリストをＶＢＡで作成すると、

新規ブックの標準モジュールに
'========================================================
Sub disp_fl_dump()
　　Columns("a:b").NumberFormatLocal = "@"
　　Call dump(1, 1)
End Sub
'===============================================================
Sub dump(rw As Long, col As Long)
　　Dim buf As String
　　Dim bt() As Byte
　　Dim flnm
　　Dim d_data
　　Dim svrw As Long
　　Dim kdx As Long
　　Dim filesize As Long
　　svrw = rw
　　flnm = Application.GetOpenFilename()
　　If flnm <> False Then
　　　 If open_fl(flnm, 16, filesize) = 0 Then
'　　　　　　　　　　　↑この16を変更すると、一行の表示バイト数の変更ができます
　　　　　jdx = 0
　　　　　Do While get_fl(bt(), kdx) = 0
　　　　　　 d_data = ""
　　　　　　 For idx = LBound(bt()) To UBound(bt())
　　　　　　　　d_data = d_data & IIf(Len(Format(Hex(bt(idx)), "00")) = 1, "0" & Hex(bt(idx)), Format(Hex(bt(idx)), "00"))
　　　　　　　　Next idx
　　　　　　 jdx = jdx + kdx
　　　　　　 Cells(svrw, col).Value = String(8 - Len(Hex(kdx)), "0") & Hex(kdx)
　　　　　　 Cells(svrw, col + 1).Value = d_data
　　　　　　 svrw = svrw + 1
　　　　　　 Loop
　　　　　cls_fl
　　　　　End If
　　　 End If
End Sub

別の標準モジュールに
'================================================================
Private flno As Long
Private restsz As Long
Private buffer As Long
'================================================================
Function open_fl(flnm, buffzs As Long, flsize As Long) As Long
　　On Error Resume Next
　　flno = FreeFile()
　　Open flnm For Binary As #flno
　　open_fl = Err.Number
　　If open_fl = 0 Then
　　　 restsz = LOF(flno)
　　　 buffer = buffzs
　　　 flsize = restsz
　　　 End If
　　On Error GoTo 0
End Function
'================================================================
Sub cls_fl()
　　On Error Resume Next
　　Close #flno
　　On Error GoTo 0
End Sub
'================================================================
Function get_fl(bt() As Byte, g_idx As Long) As Long
　　On Error Resume Next
　　Dim readbyte As Long
　　If restsz <= 0 Then
　　　 get_fl = 1
　　Else
　　　 If restsz >= buffer Then
　　　　　readbyte = buffer - 1
　　　 Else
　　　　　readbyte = restsz - 1
　　　　　End If
　　　 g_idx = Loc(flno)
　　　 ReDim bt(readbyte)
　　　 Get #flno, , bt()
　　　 get_fl = Err.Number
　　　 If get_fl = 0 Then
　　　　　restsz = restsz - readbyte - 1
　　　　　End If
　　　 End If
　　On Error GoTo 0
End Function
'================================================================
Function put_fl(bt() As Byte) As Long '今回は、使いませんが
　　On Error Resume Next
　　Put #flno, , bt()
　　put_fl = Err.Number
　　On Error GoTo 0
End Function

これでdisp_fl_dumpを実行してみてください。

指定したファイルのダンプリストがアクティブシートに表示されます。
例は、シート表示ですが、テキストファイルへの書き込みが必要なら、
変更してください。

6 hits

▼

【49370】shell関数で">"を使いたい。 よちよち 07/6/2(土) 16:20