<% Function TyoboTaisyakuTaisyohyoHokokusyo(EnshuCD, KaisyaCD, SakuseiKaisyaCD, BunsyoSyuruiCD, BunsyoNaiyoCD, AutoFlg, PrintFlg, Param1, Param2, Param3) Dim tmp Dim Kaishibi Dim Syuryobi Dim TanaorosiFlg Dim TanaorosiKubun Dim PageType PageType = "貸借対照表" Dim bExistSyuseiKinyu bExistSyuseiKinyu = 0 Query = "exec SPK伝票集計取得 '" & GB_SystemCD & "','" & EnshuCD & "', '" & KaisyaCD & "', '', -1, -1, 9" Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then bExistSyuseiKinyu = 1 End If Kaishibi = Request("Kaishibi") Syuryobi = Request("Syuryobi") TanaorosiKubun = Request("TanaorosiKubun") If Kaishibi = "" Then Kaishibi = GB_KaikeiKaishibi End If IF Syuryobi = "" Then Syuryobi = GB_KaikeiSyuryobi End If Dim RouteType RouteType = Request("RouteType") Dim ToukiSoneki ToukiSoneki = GetEnshuParam(EnshuCD, "整理記入当期損益挿入先") If ToukiSoneki = "" Then ToukiSoneki = "B948" End If Dim KanjyoCDShiire, KanjyoCDKurikoshiSyohin Dim KanjyoCDKisyuSyohinTanaoroshidaka, KanjyoCDKimatsuSyohinTanaoroshidaka Query = "exec SPM勘定科目取得特別勘定 '" & GB_SystemCD & "','" & EnshuCD & "', ''" Set Content = OpenQuery(Query) Do While Not(Content.BOF OR Content.EOF) If Content.Fields("特別勘定区分") = "DL" Then KanjyoCDShiire = Content.Fields("勘定CD") ElseIf Content.Fields("特別勘定区分") = "DG" Then KanjyoCDKisyuSyohinTanaoroshidaka = Content.Fields("勘定CD") ElseIf Content.Fields("特別勘定区分") = "DH" Then KanjyoCDKimatsuSyohinTanaoroshidaka = Content.Fields("勘定CD") ElseIf Content.Fields("特別勘定区分") = "DJ" Then KanjyoCDKurikoshiSyohin = Content.Fields("勘定CD") End If Content.MoveNext Loop Dim FontCell Dim HeightCell Dim WidthCell1 Dim WidthCell2 Dim WidthParent If PrintFlg = 0 Then FontCell = "1416" HeightCell = 20 WidthCell1 = 240 WidthCell2 = 110 WidthParent = 800 Else FontCell = "1214" HeightCell = 18 WidthCell1 = 190 WidthCell2 = 80 WidthParent = 640 End If If PrintFlg = 0 Then %>
<% Else If Param3 = "PageBreak" Then Response.Write(PageBreakBefore) '運用管理一括印刷時の改ページ End If End If %>
<% If PrintFlg = 1 Then Response.Write(PrintHeader1(AutoFlg)) End if %>
<% = SetStringInsertSpace(PageType) %>
<% Response.Write(SetDate(Syuryobi, 2)) Response.Write("　") If bExistSyuseiKinyu = 0 Then If TanaorosiKubun = "1" Then Response.Write("[帳簿棚卸後を表示]") End If Else Response.Write("[精算表整理記入適用済]") End If %>
資産 金額 構成比 負債及び資本 金額 構成比
<% If PrintFlg = 0 Then %>
<% End if %> " & vbCrLf) '///////////////////////　負債及び資本の列（右） Response.Write("
<% Dim Query Dim Content Dim DC,ww Dim TBLAC(2, 100) Dim TBLKIN(2, 100) Dim TBLNAME(2, 100) Dim TBLSUMCD(2, 100) Dim TBLSUMPM(2, 100) Dim TBLDCKubun(2, 100) Dim TBLKOSEI(2, 100) Dim TBLDSPLR(2, 100) Dim TBLDSPUL(2, 100) Dim TBLTKIN(2) Dim i,j i=0 j=0 '###########################################１．書式データ取得 Query = "exec SPM報告書書式一覧 '" & GB_SystemCD & "','" & EnshuCD & "','B'" '本番はこっち Set Content = OpenQuery(Query) Do While Not(Content.BOF Or Content.EOF) If Content.Fields("貸借") = "D" Then If IsNumeric(Content.Fields("ラインコントロール")) Then i = i + Int(Content.Fields("ラインコントロール")) ' Else ' i = i + 1 End If i = i + 1 ww = i DC = 1 Else If IsNumeric(Content.Fields("ラインコントロール")) Then j = j + Int(Content.Fields("ラインコントロール")) ' Else ' j = j + 1 End If j = j + 1 ww = j DC = 2 End If TBLAC(DC, ww) = Content.Fields("集計CD") TBLNAME(DC, ww) = Content.Fields("集計名称") TBLSUMCD(DC, ww) = Content.Fields("集計先") TBLSUMPM(DC, ww) = Content.Fields("加減区分") TBLDCKubun(DC, ww) = Content.Fields("貸借") TBLKOSEI(DC, ww) = Content.Fields("構成表示") TBLDSPLR(DC, ww) = Content.Fields("右方表示") TBLDSPUL(DC, ww) = Content.Fields("アンダーライン") If InStr(TBLNAME(DC, ww), "小計") > 0 Then TBLNAME(DC, ww) = Replace(TBLNAME(DC, ww), "　　", "　") End If Content.MoveNext Loop Dim x,y x = i y = j Dim RowCount, RowBreakNum Dim ii, jj ii = 0 jj = 0 RowCount = 0 '###########################################２．金額データ取得 Query = "exec SPK自動転記帳簿_財務諸表 '" & GB_SystemCD & "','" & EnshuCD & "', '" & KaisyaCD & "','" & Kaishibi & "','" & Syuryobi & "','B', 0, 9" Set Content = OpenQuery(Query) Dim RecordCount RecordCount = 0 If Not(Content.BOF Or Content.EOF) Then Do While Not(Content.BOF Or Content.EOF) RecordCount = RecordCount + 1 Content.MoveNext Loop Content.MoveFirst End If MaxCount = RecordCount + 2 RowBreakNum = RecordCount ReDim WK_Zandaka_KanjyoCD(MaxCount) ReDim WK_Zandaka_KanjyoName(MaxCount) ReDim WK_Zandaka_KariKingaku(MaxCount) ReDim WK_Zandaka_KashiKingaku(MaxCount) ReDim WK_Zandaka_KanjyoKubun(MaxCount) ReDim WK_Zandaka_TaisyakuKubun(MaxCount) ReDim WK_Zandaka_SyukeiCD(MaxCount) '//////////////////////////////// ワーク「残高Ｆ」を作成 Do While Not(Content.BOF Or Content.EOF) ii = ii + 1 WK_Zandaka_KanjyoCD(ii) = Content.Fields("勘定CD") WK_Zandaka_KanjyoName(ii) = Content.Fields("勘定名称") WK_Zandaka_KariKingaku(ii) = Content.Fields("借方金額") WK_Zandaka_KashiKingaku(ii) = Content.Fields("貸方金額") WK_Zandaka_KanjyoKubun(ii) = Content.Fields("勘定区分") WK_Zandaka_TaisyakuKubun(ii) = Content.Fields("貸借区分") WK_Zandaka_SyukeiCD(ii) = Content.Fields("諸表集計CD") Content.MoveNext Loop '棚卸の調整ここから If bExistSyuseiKinyu = 0 And TanaorosiKubun = "1" Then '在庫数をチェックする。 Dim KimatsuSyohinTanaoroshidaka, KisyuSyohinTanaoroshidaka, ShiireKingaku KimatsuSyohinTanaoroshidaka = KimatsuTanaoroshiKingakuSeiriKinyuMae(Syuryobi) KisyuSyohinTanaoroshidaka = KisyuTanaoroshiKingaku(Syuryobi) Dim KurikosiFLG, InsertNo ' For jj = 1 To RecordCount ' Response.Write(jj & "-" & WK_Zandaka_KanjyoCD(jj) & "
") ' Next '仕入金額を取得ここから For jj = 1 To RecordCount If WK_Zandaka_KanjyoCD(jj) = KanjyoCDShiire Then ShiireKingaku = WK_Zandaka_KariKingaku(ii + 1) - WK_Zandaka_KashiKingaku(ii + 1) Exit For End If Next '仕入金額を取得ここまで '繰越商品ここから tmp = ReplaceKanjyo(KanjyoCDKurikoshiSyohin, KimatsuSyohinTanaoroshidaka, 0) '繰越商品ここまで ' チェック用 ' For jj = 1 To RecordCount + 2 ' Response.Write(WK_Zandaka_KanjyoCD(jj) & "-") ' Response.Write(WK_Zandaka_KanjyoName(jj) & "-") ' Response.Write(WK_Zandaka_KariKingaku(jj) & "-") ' Response.Write(WK_Zandaka_KashiKingaku(jj) & "-") ' Response.Write(WK_Zandaka_TaisyakuKubun(jj) & "-") ' Response.Write("
") ' Next End If ReDim DSP_KarikataKingakuTotal(MaxCount),DSP_KashikataKingakuTotal(MaxCount) Dim DSP_SisanFusaiKingakuTotal,DSP_SisanKingakuTotal '/////////////////////////////////ワーク「残高Ｆ」から書式の科目毎に振り分ける i = 0 Dim WK_KIN,WK_AC,WK_DC,WK_PM,W_NOTF,Sww,Sxx_SET,Sxx For i = 1 To MaxCount '科目の貸借区分と集計マスタの貸借が異なっている場合の貸借補正（180216小野） '※科目の貸借区分によって出力される貸借（左右）が決められてしまうため、 '※科目の貸借区分を集計マスタの貸借に合わせることで科目貸借を実質無視させる。 Query = "exec SPM報告書書式一覧 '" & GB_SystemCD & "','" & EnshuCD & "','B'" Set Content = OpenQuery(Query) Do While Not(Content.BOF Or Content.EOF) If "" & Content.Fields("集計CD") = WK_Zandaka_SyukeiCD(i) Then WK_Zandaka_TaisyakuKubun(i) = "" & Content.Fields("貸借") Exit Do End If Content.MoveNext Loop If WK_Zandaka_TaisyakuKubun(i) = "D" Then WK_KIN = WK_Zandaka_KariKingaku(i) - WK_Zandaka_KashiKingaku(i) DC = 1 '左側指定 Else WK_KIN = WK_Zandaka_KashiKingaku(i) - WK_Zandaka_KariKingaku(i) DC = 2 '右側指定 End If 'Response.Write(WK_Zandaka_KanjyoCD(i) & "：" & WK_KIN & "
") WK_PM = "+" W_NOTF = True If WK_KIN <> 0 Then WK_AC = WK_Zandaka_SyukeiCD(i) WK_DC = WK_Zandaka_TaisyakuKubun(i) If TBLTKIN(DC) <> 0 Then TBLTKIN(DC) = ConvMoneyToInt(TBLTKIN(DC)) + ConvMoneyToInt(WK_KIN) Else TBLTKIN(DC) = ConvMoneyToInt(WK_KIN) End If For ww = 1 To x If TBLAC(DC, ww) = WK_AC And WK_AC <> "" Then '空白行(集計CD="")と諸表集計CD=""が合致してしまうので諸表集計CD=""は除外 If (WK_DC <> TBLDCKubun(DC, ww)) Then WK_KIN = WK_KIN * -1 End If If (WK_PM = "+") Then TBLKIN(DC, ww) = TBLKIN(DC, ww) + WK_KIN Else TBLKIN(DC, ww) = TBLKIN(DC, ww) - WK_KIN End If WK_AC = TBLSUMCD(DC, ww) WK_PM = TBLSUMPM(DC, ww) W_NOTF = False Exit For End If Next If (W_NOTF = True) Then '集計先未定勘定があると2行目が抜けるバグ発覚 '集計先未定勘定をトップに表示するのをやめたのでこの部分は廃止 'というわけでバグは直していません(^^; ' If (Sxx_SET <> "SET") Then ' Sxx_SET = "SET" ' Sxx = Sxx + 2 ' End If ' TBLNAME(DC, Sxx) = "集計先未定" ' TBLDSPUL(DC, Sxx) = "1" ' If (WK_PM = "+") Then ' TBLKIN(DC, Sxx) = TBLKIN(DC, Sxx) + WK_KIN ' Else ' TBLKIN(DC, Sxx) = TBLKIN(DC, Sxx) - WK_KIN ' End If Else Do Until (WK_AC = "") Or IsNull(WK_AC) If (WK_PM <> TBLSUMPM(DC, ww)) And (WK_PM = "+") Then WK_PM = "-" End If W_NOTF = True For ww = 1 To 100'y If (TBLAC(DC, ww) = WK_AC) Then W_NOTF = False Exit For End If Next If (W_NOTF = True) Then 'MsgBox "集計先が存在しません　( " & WK_AC & " )", 0, "確認して下さい" Response.Write("集計先が存在しません　( " & WK_AC & " )" & "確認して下さい") WK_AC = "" Exit Do End If If (WK_PM = "+") Then TBLKIN(DC, ww) = TBLKIN(DC, ww) + WK_KIN Else TBLKIN(DC, ww) = TBLKIN(DC, ww) - WK_KIN End If WK_AC = TBLSUMCD(DC, ww) Loop End If End If Next '###########################################３．当期利益の算出（当期損益を「整理記入当期損益挿入先」に放り込む） WK_KIN = TBLTKIN(1) - TBLTKIN(2) If (WK_KIN <> 0) Then WK_AC = ToukiSoneki WK_DC = "C" DC = 2 ' Sww = Sjj WK_PM = "+" TBLTKIN(2) = TBLTKIN(2) + WK_KIN For ww = 1 To 100'x If (TBLAC(DC, ww) = WK_AC) Then If (WK_DC <> TBLDCKubun(DC, ww)) Then WK_KIN = WK_KIN * -1 End If TBLKIN(DC, ww) = TBLKIN(DC, ww) + WK_KIN WK_AC = TBLSUMCD(DC, ww) WK_PM = TBLSUMPM(DC, ww) W_NOTF = False Exit For End If Next If (W_NOTF = True) Then If (Sxx_SET <> "SET") Then Sxx_SET = "SET" Sxx = Sxx + 2 End If TBLNAME(DC, Sxx) = "集計先未定" TBLDSPUL(DC, Sxx) = "1" If (WK_PM = "+") Then TBLKIN(DC, Sxx) = TBLKIN(DC, Sxx) + WK_KIN Else TBLKIN(DC, Sxx) = TBLKIN(DC, Sxx) - WK_KIN End If Else Do Until (WK_AC = "") Or IsNull(WK_AC) If (WK_PM <> TBLSUMPM(DC, ww)) And (WK_PM = "+") Then WK_PM = "-" End If W_NOTF = True For ww = 1 To 100'x If (TBLAC(DC, ww) = WK_AC) Then W_NOTF = False Exit For End If Next If (W_NOTF = True) Then ' MsgBox "集計先が存在しません　( " & WK_AC & " )", 0, "確認して下さい" Response.Write("集計先が存在しません　( " & WK_AC & " )" & "確認して下さい") WK_AC = "" Exit Do End If If (WK_PM = "+") Then TBLKIN(DC, ww) = TBLKIN(DC, ww) + WK_KIN Else TBLKIN(DC, ww) = TBLKIN(DC, ww) - WK_KIN End If WK_AC = TBLSUMCD(DC, ww) Loop End If End If '###########################################４．画面出力 i = 0 '///////////////////////　資産の列（左） Response.Write("") For i = 1 To x '集計先未定勘定は除外する If TBLNAME(1, i) <> "集計先未定" Then Response.Write("" & vbCrLf) '名称 Response.Write("" & vbCrLf) '金額 Response.Write("" & vbCrLf) '構成比 Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) End If Next Response.Write("
" & TBLNAME(1,i)) Response.Write("
" & Replace("" & ConvIntToMoney(TBLKIN(1,i), false, true), "-", "△")) Response.Write("
") If TBLKOSEI(1,i) = "1" and TBLKIN(1,i) <> "" AND TBLTKIN(1) <> 0 Then Response.Write(" " & ConvIntToMoney(Int(TBLKIN(1,i) * 1000 /TBLTKIN(1)) / 10, false, true) & "%") End If Response.Write("
" & vbCrLf) Response.Write("		" & vbCrLf) Response.Write("" & vbCrLf) i = 0 For i = 1 To y '集計先未定勘定は除外する If TBLNAME(2, i) <> "集計先未定" Then Response.Write("" & vbCrLf) '名称 Response.Write("" & vbCrLf) '金額 Response.Write("" & vbCrLf) '構成比 Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) End If Next Response.Write("
" & TBLNAME(2,i)) Response.Write("
" & Replace("" & ConvIntToMoney(TBLKIN(2,i), false, true), "-", "△")) Response.Write("
") If TBLKOSEI(2,i) = "1" and TBLKIN(2,i) <> "" and TBLTKIN(2) <> 0 Then Response.Write(ConvIntToMoney(Int(TBLKIN(2,i) * 1000 / TBLTKIN(2)) / 10, false, true) & "%") End If Response.Write("
" & vbCrLf) %>
<% Dim MiteiFlg MiteiFlg = 0 For jj = 1 To RecordCount If WK_Zandaka_KanjyoCD(jj) <> "" And WK_Zandaka_SyukeiCD(jj) = "" And (WK_Zandaka_KariKingaku(jj) <> 0 Or WK_Zandaka_KashiKingaku(jj) <> 0) Then '集計先未定勘定から原価勘定科目を除外する Query = "exec SPM勘定科目詳細取得2 '" & GB_SystemCD & "','" & EnshuCD & "','" & GyosyuKubun & "','" & WK_Zandaka_KanjyoCD(jj) & "'" Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then MiteiFlg = 1 Exit For End If End If Next %> <% If MiteiFlg > 0 Then %>
集計先が定まっていない残高 <% '集計先未定 For jj = 1 To RecordCount If WK_Zandaka_KanjyoCD(jj) <> "" And WK_Zandaka_SyukeiCD(jj) = "" And (WK_Zandaka_KariKingaku(jj) <> 0 Or WK_Zandaka_KashiKingaku(jj) <> 0) Then '集計先未定勘定から原価勘定科目を除外する Query = "exec SPM勘定科目詳細取得2 '" & GB_SystemCD & "','" & EnshuCD & "','" & GyosyuKubun & "','" & WK_Zandaka_KanjyoCD(jj) & "'" Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write("") Response.Write("") End If End If Next %>
勘定CD 勘 定 名 称 貸借 借 方 勘 定 貸 方 勘 定
") Response.Write(WK_Zandaka_KanjyoCD(jj)) Response.Write(" ") Response.Write(WK_Zandaka_KanjyoName(jj)) Response.Write("") If WK_Zandaka_TaisyakuKubun(jj) = "D" Then Response.Write("借") Else Response.Write("貸") End If Response.Write(" ") Response.Write(ConvIntToMoney(WK_Zandaka_KariKingaku(jj), false, false)) Response.Write("  ") Response.Write(ConvIntToMoney(WK_Zandaka_KashiKingaku(jj), false, false)) Response.Write(" 
<% End If %> <% If PrintFlg = 0 Then %>
<% End If %>
<% If PrintFlg = 0 Then %>
<% Else End if End Function Function ReplaceKanjyo(F_KanjyoCD, F_KarikataKingaku, F_KashikataKingaku) If IsNull(F_KarikataKingaku) Then F_KarikataKingaku = 0 End If If IsNull(F_KashikataKingaku) Then F_KashikataKingaku = 0 End If Dim InsertNo, KurikosiFLG Dim ii, jj Dim Query, Content InsertNo = -1 KurikosiFLG = 0 If F_KarikataKingaku <> 0 OR F_KashikataKingaku <> 0 Then For jj = 1 To MaxCount If WK_Zandaka_KanjyoCD(jj) = "" Then Exit For End If If WK_Zandaka_KanjyoCD(jj) > F_KanjyoCD Then If KurikosiFLG = 0 Then For ii = MaxCount - 1 To jj Step -1 WK_Zandaka_KanjyoCD(ii + 1) = WK_Zandaka_KanjyoCD(ii) WK_Zandaka_KanjyoName(ii + 1) = WK_Zandaka_KanjyoName(ii) WK_Zandaka_KariKingaku(ii + 1) = WK_Zandaka_KariKingaku(ii) WK_Zandaka_KashiKingaku(ii + 1) = WK_Zandaka_KashiKingaku(ii) WK_Zandaka_TaisyakuKubun(ii + 1) = WK_Zandaka_TaisyakuKubun(ii) WK_Zandaka_SyukeiCD(ii + 1) = WK_Zandaka_SyukeiCD(ii) Next InsertNo = jj KurikosiFLG = 1 ShowCount = ShowCount + 1 Exit For End If ElseIf WK_Zandaka_KanjyoCD(jj) = F_KanjyoCD Then 'すでに残高に「期末商品棚卸高」がある場合 KurikosiFLG = 1 InsertNo = jj End If Next If KurikosiFLG = 0 Then InsertNo = jj ShowCount = ShowCount + 1 End If End If If InsertNo <> -1 Then Query = "exec SPM勘定科目取得 '" & GB_SystemCD & "','" & EnshuCD & "', '" & F_KanjyoCD & "'" Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then WK_Zandaka_TaisyakuKubun(InsertNo) = Content.Fields("貸借区分") WK_Zandaka_KanjyoName(InsertNo) = Content.Fields("勘定名称") WK_Zandaka_SyukeiCD(InsertNo) = Content.Fields("諸表集計CD") End If WK_Zandaka_KanjyoCD(InsertNo) = F_KanjyoCD If WK_Zandaka_TaisyakuKubun(InsertNo) = "C" Then WK_Zandaka_KariKingaku(InsertNo) = 0 WK_Zandaka_KashiKingaku(InsertNo) = F_KashikataKingaku - F_KarikataKingaku Else WK_Zandaka_KariKingaku(InsertNo) = F_KarikataKingaku - F_KashikataKingaku WK_Zandaka_KashiKingaku(InsertNo) = 0 End If End If End Function %>