'//*************************************************//
'// //
'// 標準処理 //
'// //
'//*************************************************//
'//=========================//
'// 共通変数宣言 //
'//=========================//
Public outdata As String '// 出力内容
'// 繰り返し
Public lpstr_pos As Integer '// 繰り返しソース開始点
Public lpgyo As Integer '// 繰り返しデータ、今何行目？
'// IF文
Public no_out_flg As Integer '// 出力しないとき１
'// 作業一覧シート用
Public Const sagyo_shname As String = "作業一覧" '//シート名
Public Const sagyo_str_gyo As Integer = 5 '// 繰り返し開始行
Public Const sagyo_hina_keta As String = "A" '// 雛形の桁
Public Const sagyo_sh_keta As String = "B" '// シートの桁
Public Const sagyo_out_keta As String = "C" '// 出力の桁
'//=========================//
'// ボタンが押されたとき //
'//=========================//
Sub shiyoToFile()
Dim gyo As Integer
Dim hina_name As String
Dim sh_name As String
Dim out_name As String
'//================================//
'// 開始時の前処理（固有処理） //
'//================================//
Call initAppData
'//================================//
'//作業一覧に基づき出力（共通処理）//
'//================================//
gyo = sagyo_str_gyo
Do While Sheets(sagyo_shname).Range(sagyo_hina_keta & CStr(gyo)) ＜＞ ""
hina_name = Sheets(sagyo_shname).Range(sagyo_hina_keta & CStr(gyo))
sh_name = Sheets(sagyo_shname).Range(sagyo_sh_keta & CStr(gyo))
out_name = Sheets(sagyo_shname).Range(sagyo_out_keta & CStr(gyo))
Call makefile(hina_name, sh_name, out_name)
gyo = gyo + 1
Loop
'//================================//
'// 終了時の後処理（固有処理） //
'//================================//
Call freeAppData
MsgBox "終わりました"
End Sub
'//=========================//
'// 出力ファイル作成 //
'//=========================//
Sub makefile(infname As String, shname As String, outfname As String)
'//=========================//
'// 雛形を読み込む //
'//=========================//
Open infname For Binary Access Read As #1
fsize = FileLen(infname)
Seek #1, 1
indata = Input(fsize, #1)
Close #1
'//=========================//
'// 書き出し内容作成 //
'//=========================//
str_pos = 1 ' 開始ポイント
outdata = ""
tag_pos = InStr(str_pos, indata, "$#$")
no_out_flg = 0 ' ＩＦ文初期化
Do While (tag_pos ＞ 0)
'直前まで書き出し
If (no_out_flg = 0) Then
outdata = outdata & Mid(indata, str_pos, tag_pos - str_pos)
End If
'制御内容終わりを探す
end_pos = InStr(tag_pos + 3, indata, "$#$")
If (end_pos = 0) Then
str_pos = tag_pos + 3
Exit Do
End If
'制御内容コピー
tag_data = Mid(indata, tag_pos, end_pos - tag_pos + 3)
' 制御内容ごとに処理
str_pos = chgTagToStr(Replace(tag_data, "$#$", ""), end_pos + 3, shname)
' 次のタグ位置を探す
tag_pos = InStr(str_pos, indata, "$#$")
Loop
' 最後の残りを書き出し
If (no_out_flg = 0) Then
outdata = outdata & Mid(indata, str_pos)
End If
'//=========================//
'// 作成データ書き出し //
'//=========================//
If (Dir(outfname) ＜＞ "") Then
Kill outfname ' ファイルがあったら、削除しておく
End If
Open outfname For Binary Access Write As #1
fsize = FileLen(outfname)
Put #1, 1, outdata
Close #1
End Sub
'//=========================//
'// タグを処理する //
'//=========================//
Function chgTagToStr(tag As String, next_str_pos As Integer, shname As String) As Integer
If (Mid(tag, 1, 6) = "REPEND") Then
lpgyo = lpgyo + 1
cellpos = Replace(Mid(tag, 7), " ", "") & CStr(lpgyo)
celldata = Sheets(shname).Range(cellpos)
If (celldata = "") Then
chgTagToStr = next_str_pos
Else
chgTagToStr = lpstr_pos
End If
Exit Function
End If
If (Mid(tag, 1, 3) = "REP") Then
lpstr_pos = next_str_pos
lpgyo = CInt(Replace(Mid(tag, 4), " ", ""))
chgTagToStr = next_str_pos
Exit Function
End If
If (Mid(tag, 1, 4) = "CELL") Then
cellpos = Replace(Mid(tag, 5), " ", "")
celldata = Sheets(shname).Range(cellpos)
If (no_out_flg = 0) Then
outdata = outdata & celldata
End If
chgTagToStr = next_str_pos
Exit Function
End If
If (Mid(tag, 1, 4) = "KETA") Then
cellpos = Replace(Mid(tag, 5), " ", "") & CStr(lpgyo)
celldata = Sheets(shname).Range(cellpos)
If (no_out_flg = 0) Then
outdata = outdata & celldata
End If
chgTagToStr = next_str_pos
Exit Function
End If
If (Mid(tag, 1, 6) = "IFKETA") Then
kugiri_pos = InStr(7, tag, ",")
cellpos = Replace(Mid(tag, 7, kugiri_pos - 7), " ", "") & CStr(lpgyo)
celldata = Sheets(shname).Range(cellpos)
chkdata = Mid(tag, kugiri_pos + 1)
If (celldata = chkdata) Then
no_out_flg = 0
Else
no_out_flg = 1
End If
chgTagToStr = next_str_pos
Exit Function
End If
If (Mid(tag, 1, 6) = "IFCELL") Then
kugiri_pos = InStr(7, tag, ",")
cellpos = Replace(Mid(tag, 7, kugiri_pos - 7), " ", "")
celldata = Sheets(shname).Range(cellpos)
chkdata = Mid(tag, kugiri_pos + 1)
If (celldata = chkdata) Then
no_out_flg = 0
Else
no_out_flg = 1
End If
chgTagToStr = next_str_pos
Exit Function
End If
If (Mid(tag, 1, 5) = "IFEND") Then
no_out_flg = 0
chgTagToStr = next_str_pos
Exit Function
End If
chgTagToStr = next_str_pos
End Function
|
アクセス
トータル
ランキング
