EXCEL VBAでサイン付きパック項目を含むデータを出力したい

前提・実現したいこと

EXCELのシートでテストデータを作成したい。
１項目１セルとしている。
Xタイプ9タイプの他にサイン付きパックの項目がある。

発生している問題・エラーメッセージ

エクセル上で+00000001000と入力したデータをサイン付きパック項目00 00 00 01 00 0Cに変換する方法が分からない。

現状

1.バイナリでパック項目前までバイト形式にして書き出し
2.パック項目を変換書き出し(seekで追記)
3.パックが出てくるまで1を繰り返す

'COMP-3項目を書き出す
の部分でサインなしであれば変換できています（00 00 00 01 00 00）
ただbyte形式で変換しているためcを入れることができない状況です。

該当のソースコード

　　'データ格納用

Sub
1　　　Dim bbuf() As Byte
2    Dim s As String
3    Dim bData() As Byte
4    Dim cData() As Byte
5
6    'ファイル作成
7    Dim objFso As Object
8    Set objFso = CreateObject("Scripting.FileSystemObject")
9     
10    Dim strPath As String
11    strPath = ActiveWorkbook.Worksheets("データ作成").Range("C1").Value
12     
13    With objFso
14        If Not .FileExists(strPath) Then
15            .CreateTextFile (strPath)
16        End If
17    End With
18    Set objFso = Nothing
19
20    '空いているファイル番号を取得します。
21    FileNumber = FreeFile
22        With ActiveWorkbook.Worksheets("データ作成")
23        
24            'データをコピーする
25            copyCol = 24
26            Do While .Cells(copyCol, 2) <> ""
27                Select Case .Cells(copyCol, 2)
28                'ヘッダ時の処理
29                Case "ヘッダ"
30                       itemsu = 134
31                       dataGata = 8
32                '商品時の処理
33                Case "エンド"
34                       itemsu = 2
35                       dataGata = 23
36                '対象レコード以外の処理
37                Case Else
38                    MsgBox "レコード区分に誤りがあります！！"
39                    Exit Do
40                End Select
41                
42                'アイテム数分ループする
43                For i = 0 To itemsu - 1
44                
45                    If .Cells(copyCol, 2) = "ヘッダ" And i = 0 Then
46                        s = s & "10  "
47                        i = 1
48                    Else
49                        If .Cells(copyCol, 2) = "エンド" And i = 0 Then
50                            s = s & "99    "
51                            i = 1
52                        Else
53                        
54                            If .Cells(dataGata, 3 + i) = "COMP-3" Then
55                            
56                                'パック項目が来たら一旦書き出す
57                                Erase bbuf
58                                bbuf = StrConv(s, vbFromUnicode)
59                                
60                                Open strPath For Binary As #FileNumber
61
62                                'データ書き出し
63                                Seek #FileNumber, FileLen(strPath) + 1
64                                Put #FileNumber, , bbuf
65                                '入力ファイルを閉じます。
66                                Close #FileNumber
67                                s = ""
68                                
69                                'COMP-3項目を書き出す
70                                ReDim cData(0 To Len(.Cells(copyCol, 3 + i).Value) / 2 - 1)
71                                s = Mid(Cells(copyCol, 3 + i).Value, 2, Len(Cells(copyCol, 3 + i).Value) - 1)
72                                For j = 1 To Len(.Cells(copyCol, 3 + i).Value) Step 2
73                                    cData((j - 1) / 2) = CByte("&H" & Mid(s, j, 2))
74                                Next
75                                
76                                
77                                Open strPath For Binary As #FileNumber
78
79                                'データ書き出し
80                                Seek #FileNumber, FileLen(strPath) + 1
81                                Put #FileNumber, , cData
82                                '入力ファイルを閉じます。
83                                Close #FileNumber
84                                s = ""
85                            
86                            Else
87                                '通常項目
88                                s = s & .Cells(copyCol, 3 + i).Value
89                            End If
90                        End If
91                    End If
92
93                Next
94                '次レコードへ
95                copyCol = copyCol + 1
96            Loop
97            
98            
99            Erase bbuf
100            bbuf = StrConv(s, vbFromUnicode)
101            'ファイルをAppendモードで開きます。
102            Open strPath For Binary As #FileNumber
103            'データ書き出し
104            Seek #FileNumber, FileLen(strPath) + 1
105            Put #FileNumber, , bbuf
106            '入力ファイルを閉じます。
107            Close #FileNumber
108        End With
109       
110    '入力ファイルを閉じます。
111    Close #FileNumber

ttyp03

2020/03/09 05:26

何かしら処理をしていそうですが、これは違うのですか？何ができていて何がわからないのか明確にしてもらったほうが回答がつきやすいと思います。

kawanishi_JUKE

2020/03/09 05:37

'COMP-3項目を書き出すの部分でサインなしであれば変換できています（00 00 00 01 00 00）ただbyte形式で変換しているためcを入れることができない状況です。

行動規範の内容に同意します

回答1件

ベストアンサー

ご提示のコードを流用する形だとこんな感じでしょうか。
「'COMP-3項目を書き出す」のブロックのところを置き換えてください。

VBA
1'COMP-3項目を書き出す
2s = Mid(Cells(1, 1).Value, 2)
3s = s & IIf(Left(Cells(1, 1).Value, 1) = "+", "C", "D")
4ReDim cData(0 To Len(s) / 2 - 1)
5For j = 1 To Len(s) Step 2
6    cData((j - 1) / 2) = CByte("&H" & Mid(s, j, 2))
7Next

投稿2020/03/09 06:26

ttyp03

総合スコア17000