<% Function TyoboSonekiKeisansyoHokokusyo(EnshuCD, KaisyaCD, SakuseiKaisyaCD, BunsyoSyuruiCD, BunsyoNaiyoCD, AutoFlg, PrintFlg, Param1, Param2, Param3) 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 Dim HiNikubun, TanaorosiKubun, Kaishibi, Syuryobi, tmp, tmp2 Dim PageBreakFlg Kaishibi = Param1 Syuryobi = Param2 tmp = Param3 If tmp <> "" Then tmp2 = split(tmp, "-") HiNikubun = tmp2(0) TanaorosiKubun = tmp2(1) If UBound(tmp2) > 1 Then PageBreakFlg = tmp2(2) End If End If Dim KanjyoCDShiire, KanjyoCDKurikoshiSyohin Dim KanjyoCDKisyuSyohinTanaoroshidaka, KanjyoCDKimatsuSyohinTanaoroshidaka Dim KanjyoCDKurikoshiSoneki 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") ElseIf Content.Fields("特別勘定区分") = "DY" Then KanjyoCDKurikoshiSoneki = Content.Fields("勘定CD") End If Content.MoveNext Loop '製造原価・他勘定振替高・その他を集計するため Dim TmpShiireKanjo TmpShiireKanjo = 0 Dim FontCell Dim HeightCell Dim WidthCell1 Dim WidthCell2 Dim WidthParent If PrintFlg = 0 Then FontCell = "1416" HeightCell = 20 WidthCell1 = 280 WidthCell2 = 140 WidthParent = 700 Else FontCell = "1214" HeightCell = 18 WidthCell1 = 240 WidthCell2 = 120 WidthParent = 600 End If If PrintFlg = 0 Then %>
<% Else If PageBreakFlg = "PageBreak" Then Response.Write(PageBreakBefore) End If End If %>
<% If PrintFlg = 1 Then Response.Write(PrintHeader1(AutoFlg)) End if %>
　  <% = SetStringInsertSpace("損益計算書") %>  <% If HiNikubun = "1" Then Response.write("[売上原価を仕入高に集計]") End If %>　
自： <% = Param1 %>  〜  至： <% = Param2 %>
区分 金額 構成比
<% If PrintFlg <> 1 Then %>
<% End If %>
<% 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 ii, jj, kk ii = 0 'HiNikubun=1の際は期首商品棚卸高・期末商品棚卸高を仕入高に組み入れ '期首商品棚卸高・期末商品棚卸高・（売上原価）の各項目を非表示にしているが '現状は集計コード固定になってしまっているため可変出来るよう修正の余地あり ' '###########################################１．書式データ取得 Query = "exec SPM報告書書式一覧 '" & GB_SystemCD & "','" & EnshuCD & "','P'" Set Content = OpenQuery(Query) Do While Not(Content.BOF Or Content.EOF) Dim SyukeiCD SyukeiCD = Content.Fields("集計CD") If bExistSyuseiKinyu = 0 Or (bExistSyuseiKinyu = 1 And (HiNikubun <> "1" Or (SyukeiCD <> "P201" And SyukeiCD <> "P203" And SyukeiCD <> "P204" And SyukeiCD <> "P205"))) Then If IsNumeric(Content.Fields("ラインコントロール")) Then ii = ii + Int(Content.Fields("ラインコントロール")) ' Else ' ii = ii + 1 End If ii = ii + 1 ww = ii DC = 1 TBLAC(DC, ww) = SyukeiCD 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 bExistSyuseiKinyu = 1 And HiNikubun = "1" Then If SyukeiCD = "P202" Then TBLNAME(DC, ww) = Replace(TBLNAME(DC, ww), "3.", "") TBLSUMCD(DC, ww) = "P295" TBLSUMPM(DC, ww) = "-" End If If SyukeiCD = "P200" Then TBLDSPUL(DC, ww) = "" End If End If If InStr(TBLNAME(DC, ww), "小計") > 0 Then TBLNAME(DC, ww) = Replace(TBLNAME(DC, ww), "　　", "　") End If End If Content.MoveNext Loop Dim HokokusyoLines,yy HokokusyoLines = ii yy = jj Dim RowCount, RowBreakNum ii = 0 jj = 0 RowCount = 0 '###########################################２．金額データ取得 Query = "exec SPK自動転記帳簿_財務諸表 '" & GB_SystemCD & "','" & EnshuCD & "', '" & KaisyaCD & "','" & Kaishibi & "','" & Syuryobi & "','P', 1, 9" Set Content = OpenQuery(Query) Dim RecordCount RecordCount = 0 Do While Not(Content.BOF Or Content.EOF) RecordCount = RecordCount + 1 Content.MoveNext Loop ShowCount = RecordCount MaxCount = RecordCount + 5 RowBreakNum = MaxCount 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) Set Content = OpenQuery(Query) '//////////////////////////////// ワーク「残高Ｆ」を作成 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_KanjyoKubun(ii) = Content.Fields("勘定区分") WK_Zandaka_TaisyakuKubun(ii) = Content.Fields("貸借区分") WK_Zandaka_SyukeiCD(ii) = Content.Fields("諸表集計CD") WK_Zandaka_KariKingaku(ii) = Content.Fields("借方金額") WK_Zandaka_KashiKingaku(ii) = Content.Fields("貸方金額") ' Select Case KaisyaKbn ' Case "0" ' WK_Zandaka_KariKingaku(ii) = Content.Fields("本社借方") ' WK_Zandaka_KashiKingaku(ii) = Content.Fields("本社貸方") ' Case "1" ' WK_Zandaka_KariKingaku(ii) = Content.Fields("支店借方") ' WK_Zandaka_KashiKingaku(ii) = Content.Fields("支店貸方") ' Case Else ' WK_Zandaka_KariKingaku(ii) = Content.Fields("本社借方") + Content.Fields("支店借方") ' WK_Zandaka_KashiKingaku(ii) = Content.Fields("本社貸方") + Content.Fields("支店貸方") ' End Select If Content.Fields("勘定CD") = KanjyoCDKurikoshiSoneki Then WK_Zandaka_SyukeiCD(ii) = "P910" End If '売上原価を仕入高に集計する場合は製造原価・他勘定振替高・その他を別集計しておく If bExistSyuseiKinyu = 1 And HiNikubun = "1" And (WK_Zandaka_SyukeiCD(ii) = "P206" Or WK_Zandaka_SyukeiCD(ii) = "P207" Or WK_Zandaka_SyukeiCD(ii) = "P208") Then If WK_Zandaka_TaisyakuKubun(ii) = "D" Then TmpShiireKanjo = TmpShiireKanjo - WK_Zandaka_KariKingaku(ii) - WK_Zandaka_KashiKingaku(ii) Else TmpShiireKanjo = TmpShiireKanjo + WK_Zandaka_KariKingaku(ii) - WK_Zandaka_KashiKingaku(ii) End If End If Content.MoveNext Loop '棚卸の調整ここから If (bExistSyuseiKinyu = 0 And TanaorosiKubun = "1") Or (bExistSyuseiKinyu = 1 And HiNikubun <> "1") Then '在庫数をチェックする。 Dim KimatsuSyohinTanaoroshidaka, KisyuSyohinTanaoroshidaka KisyuSyohinTanaoroshidaka = KisyuTanaoroshiKingaku(Syuryobi) KimatsuSyohinTanaoroshidaka = KimatsuTanaoroshiKingaku(Syuryobi) Dim KurikosiFLG, InsertNo Dim i ,j ' For jj = 1 To RecordCount ' Response.Write(jj & "-" & WK_Zandaka_KanjyoCD(jj) & "
") ' Next '繰越商品を削除ここから For jj = 1 To RecordCount If WK_Zandaka_KanjyoCD(jj) = KanjyoCDKurikoshiSyohin Then For ii = jj To RecordCount - 1 WK_Zandaka_KanjyoCD(ii) = WK_Zandaka_KanjyoCD(ii + 1) WK_Zandaka_KanjyoName(ii) = WK_Zandaka_KanjyoName(ii + 1) WK_Zandaka_KariKingaku(ii) = WK_Zandaka_KariKingaku(ii + 1) WK_Zandaka_KashiKingaku(ii) = WK_Zandaka_KashiKingaku(ii + 1) WK_Zandaka_TaisyakuKubun(ii) = WK_Zandaka_TaisyakuKubun(ii + 1) WK_Zandaka_SyukeiCD(ii) = WK_Zandaka_SyukeiCD(ii + 1) Next WK_Zandaka_KanjyoCD(ii) = "" WK_Zandaka_KanjyoName(ii) = "" WK_Zandaka_KariKingaku(ii) = null WK_Zandaka_KashiKingaku(ii) = null WK_Zandaka_TaisyakuKubun(ii) = "" WK_Zandaka_SyukeiCD(ii) = "" ShowCount = ShowCount - 1 Exit For End If Next '繰越商品を削除ここまで '期首商品棚卸高ここから tmp = ReplaceKanjyo(KanjyoCDKisyuSyohinTanaoroshidaka, KisyuSyohinTanaoroshidaka, 0) Query = "exec SPK伝票集計取得 '" & GB_SystemCD & "','" & EnshuCD & "', '" & KaisyaCD & "', '" & KanjyoCDKisyuSyohinTanaoroshidaka & "', 0, 1, 9" Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then tmp = ReplaceKanjyo(KanjyoCDKisyuSyohinTanaoroshidaka, Content.Fields("借方金額"), Content.Fields("貸方金額")) End If '期首商品棚卸高ここまで '期末商品棚卸高ここから tmp = ReplaceKanjyo(KanjyoCDKimatsuSyohinTanaoroshidaka, 0, KimatsuSyohinTanaoroshidaka) Query = "exec SPK伝票集計取得 '" & GB_SystemCD & "','" & EnshuCD & "', '" & KaisyaCD & "', '" & KanjyoCDKimatsuSyohinTanaoroshidaka & "', 0, 1, 9" Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then tmp = ReplaceKanjyo(KanjyoCDKimatsuSyohinTanaoroshidaka, Content.Fields("借方金額"), Content.Fields("貸方金額")) End If '期末商品棚卸高ここまで If bExistSyuseiKinyu = 1 Then 'tmp = ReplaceKanjyo(KanjyoCDShiire, KityuShiireKingaku(Syuryobi), 0) 'KityuShiireKingakuでは決算整理仕訳の消費税が引かれないのでダメ（190318小野） If "" & KanjyoCDShiire <> "" Then Query = "exec SPK伝票集計取得 '" & GB_SystemCD & "','" & EnshuCD & "', '" & KaisyaCD & "', '" & KanjyoCDShiire & "', 0, 1, 9" '決算整理も含める Set Content = OpenQuery(Query) If Not(Content.BOF Or Content.EOF) Then tmp = Content.Fields("借方金額") - Content.Fields("貸方金額") End If End If tmp = ReplaceKanjyo(KanjyoCDShiire, tmp + KimatsuSyohinTanaoroshidaka, 0) '期末商品棚卸高が引かれているので加算する End If ' チェック用 ' 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(WK_Zandaka_SyukeiCD(jj) & "-") ' Response.Write("
") ' Next End If ReDim DSP_KarikataKingakuTotal(RecordCount),DSP_KashikataKingakuTotal(RecordCount) Dim DSP_SisanFusaiKingakuTotal,DSP_SisanKingakuTotal '/////////////////////////////////ワーク「残高Ｆ」から書式の科目毎に振り分ける ii = 0 Dim WK_KIN,WK_AC,WK_DC,WK_PM,W_NOTF,Sww,Sxx_SET,Sxx For ii = 1 To MaxCount DC = 1 If WK_Zandaka_TaisyakuKubun(ii) = "D" Then WK_KIN = WK_Zandaka_KariKingaku(ii) - WK_Zandaka_KashiKingaku(ii) Else WK_KIN = WK_Zandaka_KashiKingaku(ii) - WK_Zandaka_KariKingaku(ii) End If WK_PM = "+" W_NOTF = True If WK_KIN <> 0 Then WK_AC = WK_Zandaka_SyukeiCD(ii) '集計先 WK_DC = WK_Zandaka_TaisyakuKubun(ii) '貸借区分 If TBLTKIN(DC) <> 0 Then TBLTKIN(DC) = ConvMoneyToInt(TBLTKIN(DC)) + ConvMoneyToInt(WK_KIN) Else TBLTKIN(DC) = ConvMoneyToInt(WK_KIN) End If '集計CDに該当する行に加算する For jj = 1 To HokokusyoLines If TBLAC(DC, jj) = WK_AC And WK_AC <> "" Then '空白行(集計CD="")と諸表集計CD=""が合致してしまうので諸表集計CD=""は除外 If (WK_DC <> TBLDCKubun(DC, jj)) Then WK_KIN = WK_KIN * -1 End If If (WK_PM <> "+") Then WK_KIN = WK_KIN * -1 End If TBLKIN(DC, jj) = TBLKIN(DC, jj) + WK_KIN WK_AC = TBLSUMCD(DC, jj) WK_PM = TBLSUMPM(DC, jj) W_NOTF = False ww = jj Exit For End If Next End If Next '売上原価を仕入高に集計する場合は製造原価・他勘定振替高・その他を加算する If bExistSyuseiKinyu = 1 And HiNikubun = "1" Then For jj = 1 To HokokusyoLines If TBLAC(DC, jj) = "P202" Then TBLKIN(DC, jj) = TBLKIN(DC, jj) + TmpShiireKanjo Exit For End If Next End If For jj = 1 To HokokusyoLines If TBLKIN(DC, jj) <> "" Then For kk = jj + 1 To HokokusyoLines If TBLAC(DC, kk) = TBLSUMCD(DC, jj) Then If TBLSUMPM(DC, jj) <> "-" Then TBLKIN(DC, kk) = TBLKIN(DC, kk) + TBLKIN(DC, jj) Else TBLKIN(DC, kk) = TBLKIN(DC, kk) - TBLKIN(DC, jj) End If End If Next End If Next '###########################################３．当期利益の算出 '###########################################４．画面出力 ii = 0 '///////////////////////　資産の列（左） Response.Write("") For ii = 1 To HokokusyoLines '売上原価を仕入高に集計する場合は製造原価・他勘定振替高・その他を除外する If (bExistSyuseiKinyu = 1 And HiNikubun = "1") And (TBLAC(1, ii) = "P206" Or TBLAC(1, ii) = "P207" Or TBLAC(1, ii) = "P208") Then Else Response.Write("" & vbCrLf) '名称 Response.Write("" & vbCrLf) '金額 If TBLDSPLR(1,ii) = "R" Then Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) Else Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) End If '構成比 Response.Write("" & vbCrLf) Response.Write("" & vbCrLf) End If Next Response.Write("
" & TBLNAME(1,ii)) Response.Write("
") Response.Write("
") ' If TBLAC(1, ii) <> "" Then Response.Write(ConvIntToMoney(TBLKIN(1,ii), false, true)) ' End If Response.Write("
") ' If TBLAC(1, ii) <> "" Then Response.Write(ConvIntToMoney(TBLKIN(1,ii), false, true)) ' End If Response.Write("
") Response.Write("
") If TBLKOSEI(1,ii) = "1" and TBLKIN(1,ii) <> 0 and TBLKIN(1,ii) <> "" and TBLKIN(1,1) <> "" Then 'Response.Write(" " & Int(TBLKIN(1,ii) * 1000 / TBLKIN(1, 1)) / 10 & "%") Response.Write(" " & Fix(TBLKIN(1,ii) * 10000 / TBLKIN(1, 1) + 0.5) / 100 & "%") End If Response.Write("
" & vbCrLf) '///////////////////////　負債及び資本の列（右） %>
<% Dim MiteiFlg MiteiFlg = 0 For jj = 1 To RecordCount If WK_Zandaka_KanjyoCD(jj) <> "" And WK_Zandaka_SyukeiCD(jj) = "" 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) = "" 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 <> 1 Then %>
<% End If %>
<% If PrintFlg = 0 Then %>
<% 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 %>