Calculate メソッド

Transcription

1 Rem ==================================================================== 1 Rem ==================================================================== Rem ダイアログの起動 設定変更プログラム 2 Rem ダイアログの起動 設定変更プログラム Rem (Copyright:Shuichi Sunaga 2012) 3 Rem (Copyright:Shuichi Sunaga 2012) Rem Rem Rem (Ver. 2007/03/31: 101 行 ) 5 Rem (Ver. 2007/03/31: 101 行 ) Rem (Ver. 2008/02/10:336 行 : 設定変更時のチェック ) 6 Rem (Ver. 2008/02/10:336 行 : 設定変更時のチェック ) Rem (Ver. 2008/12/12::576 行 : システム使用開始日を1 日に限定 / 新資産領域確保は行表示へ ) 7 Rem (Ver. 2008/12/12::576 行 : システム使用開始日を1 日に限定 / 新資産領域確保は行表示へ ) Rem (Ver. 2009/08/14::685 行 :XFDFolder 指定 )(Ver. 2009/10/20::754 行 :UniCode 変換 ) 8 Rem (Ver. 2009/08/14::685 行 :XFDFolder 指定 )(Ver. 2009/10/20::754 行 :UniCode 変換 ) Rem (Ver. 2009/12/02::882 行 : 設定変更時のメッセージを集成 ) 9 Rem (Ver. 2009/12/02::882 行 : 設定変更時のメッセージを集成 ) Rem (Ver. 2009/12/14:1029 行 : 償却方法設定変更に応じた ファイル新規保存 メッセージ ) 10 Rem (Ver. 2009/12/14:1012 行 : 償却方法設定変更に応じた ファイル新規保存 メッセージ ) Rem Rem Rem Sub OnOpen() 12 Rem Sub OnOpen() Rem Sub IntroTo3D(optional prm$) 13 Rem Sub IntroTo3D(optional prm$) Rem Sub BJHDlgOpen() 14 Rem Sub BJHDlgOpen() Rem Sub VeriUName() 15 Rem Sub VeriUName() Rem Sub soptinitialuse() 16 Rem Sub soptinitialuse() Rem Sub soptcontinue() 17 Rem Sub soptcontinue() Rem Sub soptuserchange() 18 Rem Sub soptuserchange() Rem Sub getdialogdata() 19 Rem Sub getdialogdata() Rem Sub IntDMTbl(ByVal c%) 20 Rem Sub IntDMTbl(ByVal c%) Rem Sub getdmtbl(byval c%) 21 Rem Sub getdmtbl(byval c%) Rem Sub OnPBttn() 22 Rem Sub OnPBttn() Rem Sub DocStoreAs() 23 Rem Sub DocStoreAs() Rem Sub StoreURLChg() 24 Rem Sub StoreURLChg() Rem Function WhatClsChg$() 25 Rem Function WhatClsChg$() Rem Sub VeriConsAft() 26 Rem Sub VeriConsAft() Rem Sub VeriCons() 27 Rem Sub VeriCons() Rem Sub VeriCB(ByVal h%) 28 Rem Sub VeriCB(ByVal h%) Rem Sub OnOut() 29 Rem Sub OnOut() Rem Sub DefDPRMtd() 30 Rem Sub DefDPRMtd() Rem Sub GetMsgTxt$(ByVal msgnum%) 31 Rem Sub GetMsgTxt$(ByVal msgnum%) Rem Sub XFDFFolder() 32 Rem Sub XFDFFolder() Rem Sub OptNoChg() 33 Rem Sub OptNoChg() Rem Sub OptYesChg() 34 Rem Sub OptYesChg() Rem Sub ThisSheetUnProtect() 35 Rem Sub ThisSheetUnProtect() Rem Sub ColShowHide() 36 Rem Sub ColShowHide() Rem Rem Option Explicit 38 Option Explicit Dim BJHDlg As object, prelist$(2), sym$ 39 Dim BJHDlg As object, prelist$(0 to 2), sym$ Dim CLS(0 to 7) As Object, BDM(0 to 7) As Object, TDM(0 to 7) As Object, CB(0 To 7) As Object 40 Dim CLS(0 to 7) As Control, BDM(0 to 7) As Control, TDM(0 to 7) As Control, CB(0 To 7) As Control Dim BCH(0 To 7) As Object, TCH(0 To 7) As Object, CBCH(0 To 7) As Object 41 Dim BCH(0 To 7) As Control, TCH(0 To 7) As Control, CBCH(0 To 7) As Control Sub OnOpen() 42 Sub OnOpen() dim xmousehdlr as Object 43 Rem Excel VBAではListerの登録はせず Object 名 _ClickのSubでマウスEventを認識 xmousehdlr = CreateUnoListener("Ms_","com.sun.star.awt.XMouseClickHandler") 44 ThisComponent.CurrentController.addMouseClickHandler(xMouseHdlr) 45 IntroTo3D("YS") 46 IntroTo3D("YS") End Sub 47 End Sub Sub IntroTo3D(optional prm$) 48 Sub IntroTo3D(optional prm$) dim oprocessservicemanager as Object 49 BasicLibraries.LoadLibrary("OOoTA") 50 BasicLibraries.LoadLibrary("OOo3D") 51 DialogLibraries.LoadLibrary("OOo3D") 52 RegisterDocL 53 Set acontroller = ThisComponent.CurrentController 54 Set osheets = ThisComponent.Sheets 55 Set dispatcher = createunoservice("com.sun.star.frame.dispatchhelper") 56 oprocessservicemanager = GetProcessServiceManager() 57 Set ofunctionaccess = oprocessservicemanager.createinstance("com.sun.star.sheet.functionaccess") 58 Set WkCL = osheets.getbyname("cl") 59 Set WkCL = ActiveWorkbook.Worksheets("CL") Set WkYK = osheets.getbyname("yuk") 60 Set WkYK = ActiveWorkbook.Worksheets("YUK") Set WkMK = osheets.getbyname("muk") 61 Set WkMK = ActiveWorkbook.Worksheets("MUK") If prm$ <> "NO" Then 62 If prm$ <> "NO" Then VeriUName() 63 VeriUName Set WkTBL = osheets.getbyname("tbl") 64 Set WkTBL = ActiveWorkbook.Worksheets("TBL") Set WkTBL0 = osheets.getbyname("tbl0") 65 Set WkTBL0 = ActiveWorkbook.Worksheets("TBL0") End If 66 End If GetDates() 67 GetDates ページ 1

2 Set asheet = acontroller.activesheet 68 Set asheet = ActiveSheet asname$ = asheet.getname() 69 asname$ = asheet.name End Sub 70 End Sub Sub BJHDlgOpen() 71 Sub BJHDlgOpen() Dim i%, ob$, ot$ 72 Dim nml%, onm%, mycontrol IntroTo3D("NO") 73 IntroTo3D("NO") Set BJHDlg = CreateUnoDialog(DialogLibraries.OOo3D.BJH) 74 Set BJHDlg = BJH BJHDlg.Model.PositionX = 0 75 BJHDlg.Left = 0 BJHDlg.Model.PositionY = 0 76 BJHDlg.Top = 0 BJHDlg.Model.Height = BJHDlg.Height = BJHDlg.FBX.Value = False Rem MouseListnerの設定 Rem Controlの設定 omlistener = CreateUnoListener("MouseListener_", "com.sun.star.awt.xmouselistener") 80 For Each mycontrol In BJHDlg.Controls For i% = 0 To 7 81 nml% = Len(myControl.Name) Set BDM(i%) = BJHDlg.GetControl("B"& CStr(i%)) 82 onm% = Val(Right(myControl.Name, 1)) Set TDM(i%) = BJHDlg.GetControl("T"& CStr(i%)) 83 If nml% = 4 And Left(myControl.Name, 3) = "Cls" Then Set CLS(i%) = BJHDlg.GetControl("Cls"& CStr(i%)) 84 Set CLS(onm%) = mycontrol Set CB(i%) = BJHDlg.GetControl("CB"& CStr(i%)) 85 ElseIf nml% = 2 And Left(myControl.Name, 1) = "B" Then Set BCH(i%) = BJHDlg.GetControl("BCH"& CStr(i%)) 86 Set BDM(onm%) = mycontrol Set TCH(i%) = BJHDlg.GetControl("TCH"& CStr(i%)) 87 ElseIf nml% = 2 And Left(myControl.Name, 1) = "T" Then Set CBCH(i%) = BJHDlg.GetControl("CBCH"& CStr(i%)) 88 Set TDM(onm%) = mycontrol BDM(i%).addMouseListener(oMListener) 89 ElseIf nml% = 3 And Left(myControl.Name, 2) = "CB" Then TDM(i%).addMouseListener(oMListener) 90 Set CB(onm%) = mycontrol 91 ElseIf nml% = 4 And Left(myControl.Name, 3) = "BCH" Then 92 Set BCH(onm%) = mycontrol 93 ElseIf nml% = 4 And Left(myControl.Name, 3) = "TCH" Then 94 Set TCH(onm%) = mycontrol 95 ElseIf nml% = 5 And Left(myControl.Name, 4) = "CBCH" Then 96 Set CBCH(onm%) = mycontrol 97 End If Next i% 98 Next Rem Rem soptcontinue() 100 soptcontinue getdialogdata() 101 getdialogdata 102 BJHDlg.FBX.Value = True setcolarray("yuk") 103 setcolarray("yuk") BJHDlg.GetCOntrol("CommandButton2").SetFocus 104 BJHDlg.CommandButton2.SetFocus BJHDlg.execute() 105 BJHDlg.Show BJHDlg.endExecute() 106 End Sub 107 End Sub Sub VeriUName() 108 Sub VeriUName() MsgTtl$ = "OOo3D"&chr(&H6E1B)&chr(&H4FA1)&chr(&H511F)&chr(&H5374) 109 MsgTtl$ = "Ooo3D 減価償却 & CoName$ = CellString(WkCL, 1, 2) 110 CoName$ = CellString(WkCL, 1, 2) if Len(CoName$) = 0 then 111 if Len(CoName$) = 0 then MsgTxt$ = chr(&h4f1a)&chr(&h793e)&chr(&h540d)&chr(&h306e)&chr(&h767b) 112 MsgTxt$ = 会社名の登録がありません MsgTxt$ = MsgTxt$ & chr(&h9332)&chr(&h304c)&chr(&h3042)&chr(&h308a)&chr(&h307e) 113 MsgTxt$ = MsgTxt$ & chr(&h305b)&chr(&h3093)&chr(&h3002)&chr(13) 114 Rem 会社名の登録がありません 115 MsgTxt$ = MsgTxt$ & chr(&h30b7)&chr(&h30b9)&chr(&h30c6)&chr(&h30e0)&chr(&h306e) 116 MsgTxt$ = MsgTxt$ & システムの設定 (ALT A Z) 画面からY & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h8a2d)&chr(&h5b9a)&chr(&hff08)&chr(&h0041)&chr(&h004c) 117 MsgTxt$ = MsgTxt$ & chr(&h0054)&chr(&h2192)&chr(&h0041)&chr(&h2192)&chr(&h005a) 118 MsgTxt$ = MsgTxt$ & chr(&hff09)&chr(&h753b)&chr(&h9762)&chr(&h304b)&chr(&h3089)&chr(13) 119 Rem システムの設定 (Alt A Z) 画面から 120 MsgTxt$ = MsgTxt$ & chr(&h4f1a)&chr(&h793e)&chr(&h540d)&chr(&h3092)&chr(&h767b) 121 MsgTxt$ = MsgTxt$ & 会社名を登録してから再度実行して下さい MsgTxt$ = MsgTxt$ & chr(&h9332)&chr(&h3057)&chr(&h3066)&chr(&h304b)&chr(&h3089) 122 MsgTxt$ = MsgTxt$ & chr(&h518d)&chr(&h5ea6)&chr(&h5b9f)&chr(&h884c)&chr(&h3057) 123 MsgTxt$ = MsgTxt$ & chr(&h3066)&chr(&h4e0b)&chr(&h3055)&chr(&h3044)&chr(&h3002) 124 Rem 会社名を登録してから再度実行して下さい 125 Msgbox(MsgTxt$, 0, MsgTtl$) 126 Msgbox MsgTxt$, vbokonly, MsgTtl$ End 127 End End If 128 End If End Sub 129 End Sub Sub soptinitialuse() 130 Sub soptinitialuse() BJHDlg.Title = "[ OOo 減価償却システム設定ダイアログ ] - 新規導入の場合 " 131 BJHDlg.Caption = "[ Ooo 減価償却システム設定ダイアログ ] - 新規導入の場合 " BJHDlg.GetControl("MODE").Model.BackgroundColor = BJHDlg.GetControl("OptInitialUse").Model.BackgroundColor 132 BJHDlg.MODE.BackColor = BJH.OptInitialUse.BackColor BJHDlg.GetControl("MODE").Model.HelpText = BJHDlg.GetControl("OptInitialUse").Model.HelpText 133 BJHDlg.MODE.ControlTipText = BJH.OptInitialUse.ControlTipText BJHDlg.GetControl("OptInitialUse").State = BJHDlg.OptInitialUse.Value = 1 ページ 2

3 BJHDlg.GetControl("OptContinue").State = BJHDlg.OptContinue.Value = 0 BJHDlg.GetControl("OptUserChange").State = BJHDlg.OptUserChange.Value = 0 End Sub 137 End Sub Sub soptcontinue() 138 Sub soptcontinue() BJHDlg.Title = "[ OOo 減価償却システム設定ダイアログ ] - 従来からの使用継続の場合 " 139 BJHDlg.Caption = "[ OOo 減価償却システム設定ダイアログ ] - 従来からの使用継続の場合 " BJHDlg.GetControl("MODE").Model.BackgroundColor = BJHDlg.GetControl("OptContinue").Model.BackgroundColor 140 BJHDlg.MODE.BackColor = BJH.OptContinue.BackColor BJHDlg.GetControl("MODE").Model.HelpText = BJHDlg.GetControl("OptContinue").Model.HelpText 141 BJHDlg.MODE.ControlTipText = BJH.OptContinue.ControlTipText BJHDlg.GetControl("OptInitialUse").State = BJHDlg.OptInitialUse.Value = 0 BJHDlg.GetControl("OptContinue").State = BJHDlg.OptContinue.Value = 1 BJHDlg.GetControl("OptUserChange").State = BJHDlg.OptUserChange.Value = 0 End Sub 145 End Sub Sub soptuserchange() 146 Sub soptuserchange() BJHDlg.Title = "[ OOo 減価償却システム設定ダイアログ ] - 別会社での転用開始の場合 " 147 BJHDlg.Caption = "[ OOo 減価償却システム設定ダイアログ ] - 別会社での転用開始の場合 " BJHDlg.GetControl("MODE").Model.BackgroundColor = BJHDlg.GetControl("OptUserChange").Model.BackgroundColor 148 BJHDlg.MODE.BackColor = BJH.OptUserChange.BackColor BJHDlg.GetControl("MODE").Model.HelpText = BJHDlg.GetControl("OptUserChange").Model.HelpText 149 BJHDlg.MODE.ControlTipText = BJH.OptUserChange.ControlTipText BJHDlg.GetControl("OptInitialUse").State = BJHDlg.OptInitialUse.Value = 0 BJHDlg.GetControl("OptContinue").State = BJHDlg.OptContinue.Value = 0 BJHDlg.GetControl("OptUserChange").State = BJHDlg.OptUserChange.Value = 1 End Sub 153 End Sub Sub getdialogdata() 154 Sub getdialogdata() dim DcName$, i%, iniymd$, nymd&, estym$ 155 dim DcName$, i%, iniymd$, nymd&, estym$ Rem Rem DcName$ = orgdir$() ' 付随的にsDirFile$(1) も取得される 157 DcName$ = orgdir$ ' 付随的にsDirFile(1) も取得される Rem ( 会社名 ) Rem ( 会社名 ) BJHDlg.GetControl("CoName").Text = CellString(WkCL, 1, 2) 159 BJHDlg.CoName.Value = CellString(WkCL, 1, 2) BJHDlg.GetControl("DocNMBox").Text = sdirfile$(1) 160 BJHDlg.DocNMBox.Value = sdirfile(1) Rem ( 設立年月 ) Rem ( 設立年月 ) estym$ = GetDate("Estb","FYM") 162 estym$ = GetDate("Estb","FYM") If Len(estYM$)=0 Then 163 If Len(estYM$)=0 Then BJHDlg.GetControl("eYR").Text = Year(Now()) 164 BJHDlg.eYR.Value = Year(Now()) BJHDlg.GetControl("eMo").Text = Month(Now()) 165 BJHDlg.eMo.Value = Month(Now()) Else 166 Else BJHDlg.GetControl("eYR").Text = Left(estYM$, 4) 167 BJHDlg.eYR.Value = Left(estYM$, 4) BJHDlg.GetControl("eMo").Text = Val(Right(estYM$, 2)) 168 BJHDlg.eMo.Value = Val(Right(estYM$, 2)) End If 169 End If Rem ( 使用開始年月日 ) Rem ( 使用開始年月日 ) iniymd$ = GetDate("Strt","Date") 171 iniymd$ = GetDate("Strt","Date") If Len(iniYMD$)=0 Then 172 If Len(iniYMD$)=0 Then BJHDlg.GetControl("sYR").Text = Year(Now()) 173 BJHDlg.sYR.Value = Year(Now()) BJHDlg.GetControl("sMO").Text = Month(Now()) 174 BJHDlg.sMO.Value = Month(Now()) Else 175 Else nymd& = DateValue(iniYMD$) nymd& = DateValue(iniYMD$) + 1 BJHDlg.GetControl("sYR").Text = Year(nYMD&) 177 BJHDlg.sYR.Value = Year(nYMD&) BJHDlg.GetControl("sMO").Text = Month(nYMD&) 178 BJHDlg.sMO.Value = Month(nYMD&) End If 179 End If Rem ( 償却方法 ) Rem ( 償却方法 ) prelist$(0) = chr(&h8a72)&chr(&h5f53)&chr(&h306a)&chr(&h3057) 該当なし 181 prelist(0) = 該当なし prelist$(1) = chr(&h5b9a)&chr(&h984d)&chr(&h6cd5) 定額法 182 prelist(1) = 定額法 For i% = 0 to For i% = 0 to 7 If i% = 7 Then 無形固定資産 184 ' If i% = 7 Then prelist$(2) = chr(&h671f)&chr(&h9593)&chr(&h6309)&chr(&h5206)&chr(&h6cd5) 185 prelist(2) = " 期間按分法 " Else 186 Else prelist$(2) = chr(&h5b9a)&chr(&h7387)&chr(&h6cd5) 187 prelist(2) = 定率法 End If 188 End If IntDMTbl(i%) 189 IntDMTbl(i%) getdmtbl(i%) 190 getdmtbl(i%) Next i% 191 Next i% Rem Rem If CellString(WkCL, 20, 2) = "NO" Then 193 If CellString(WkCL, 20, 2) = "NO" Then BJHDlg.GetControl("OptNo").Model.State = 1 大文字小文字 194 BJHDlg.OptNo.Value = 1 ElseIf CellString(WkCL, 20, 2) = "YES" Then 195 ElseIf CellString(WkCL, 20, 2) = "YES" Then BJHDlg.GetControl("OptYes").Model.State = 1 大文字小文字 196 BJHDlg.OptYes.Value = 1 If UCase(CellString(WkCL, 20, 3)) = ".XFDF" Then 197 If UCase(CellString(WkCL, 20, 3)) = ".XFDF" Then BJHDlg.GetControl("OptXFDF").Model.State = 1 大文字小文字 198 BJHDlg.OptXFDF.Value = 1 ElseIf UCase(CellString(WkCL, 20, 3)) = ".XML" Then 199 ElseIf UCase(CellString(WkCL, 20, 3)) = ".XML" Then BJHDlg.GetControl("OptXML").Model.State = 1 大文字小文字 200 BJHDlg.OptXML.Value = 1 End If 201 End If ページ 3

4 End If 202 End If End Sub 203 End Sub Sub IntDMTbl(ByVal c%) 204 Sub IntDMTbl(ByVal c%) 205 If BJHDlg.FBX.Value = False Then If Len(BJHDlg.GetControl("SorNM").Text) = 0 Then 206 BCH(c%).Text = CellString(WkCL, 11 + c%, 2) 207 BCH(c%).Value = CellString(WkCL, 11 + c%, 2) TCH(c%).Text = CellString(WkCL, 11 + c%, 4) 208 TCH(c%).Value = CellString(WkCL, 11 + c%, 4) CBCH(c%).Model.State = CellString(WkCL, 11 + c%, 6) 209 CBCH(c%).Value = CellString(WkCL, 11 + c%, 6) End If 210 If Len(BCH(c%).Text)=0 Then 211 If Len(BCH(c%).Value) = 0 Then setcellstring WkCL, 11+c%, 2, prelist$(0) 212 SetCellString WkCL, 11 + c%, 2, prelist(0) End If 213 End If If Len(TCH(c%).Text)=0 Then 214 If Len(TCH(c%).Value) = 0 Then setcellstring WkCL, 11+c%, 4, prelist$(0) 215 SetCellString WkCL, 11 + c%, 4, prelist(0) End If 216 End If 217 End If End Sub 218 End Sub Sub getdmtbl(byval c%) 219 Sub getdmtbl(byval c%) 220 dim i% Rem ( 会計償却方法 ) Rem ( 会計償却方法 ) If BJHDlg.FBX.Value = False Then BDM(c%).removeItems(0,BDM(c%).ItemCount) 225 BDM(c%).Clear TDM(c%).removeItems(0,TDM(c%).ItemCount) 226 TDM(c%).Clear If c% = 0 then 227 If c% = 0 then BDM(c%).AddItem(preList$(0), 0) 228 BDM(c%).AddItem prelist(0) BDM(c%).AddItem(preList$(1), 1) 229 BDM(c%).AddItem prelist(1) TDM(c%).AddItem(preList$(0), 0) 230 TDM(c%).AddItem prelist(0) TDM(c%).AddItem(preList$(1), 1) 231 TDM(c%).AddItem prelist(1) Else 232 Else 233 For i% = 0 to 2 BDM(c%).AddItems(preList$(), 0) 234 BDM(c%).AddItem prelist(i%) TDM(c%).AddItems(preList$(), 0) 235 TDM(c%).AddItem prelist(i%) 236 Next i% End If 237 End If 238 End If BDM(c%).setText(BCH(c%).Text) 239 BDM(c%).Value=BCH(c%) TDM(c%).setText(TCH(c%).Text) 240 TDM(c%).Value =TCH(c%) Rem -----( 償却方法不一致チェックボックス ) Rem -----( 償却方法不一致チェックボックス )----- CB(c%).Model.State=CBCH(c%).Model.State 243 CB(c%).Value=CBCH(c%) End Sub 244 End Sub Sub OnPBttn() 245 Sub OnPBttn() dim osfa As Object 246 dim osfa As Object dim olb As object, olt As object, ocb As object, ocls As Object 247 dim olb As object, olt As objectq dim syr$, smo$, sday$, estyr$, estmo$, imo% 248 dim syr$, smo$, sday$, estyr$, estmo$, imo% dim MaxDAY%, nymd&, iniymd$, sm%, smd$, sfy$, sym$ 249 dim MaxDAY%, nymd&, iniymd$, sm%, smd$, sfy$, sym$ dim i%, resp% 250 dim i%, resp% Rem Rem MsgTtl$ = chr(&h5165)&chr(&h529b)&chr(&h6f0f)&chr(&h30c1)&chr(&h30a7) 252 MsgTtl$ = 入力漏チェック MsgTtl$ = MsgTtl$ & chr(&h30c3)&chr(&h30af) 253 Rem 入力漏チェック Rem ( 会社名 ) Rem ( 会社名 ) CoName$ = BJHDlg.GetControl("CoName").Text() 256 CoName$ = BJHDlg.CoName.Value If Len(CoName$) = 0 Then 257 If Len(CoName$) = 0 Then MsgTxt$ = chr(&h4f1a)&chr(&h793e)&chr(&h540d)&chr(&h304c)&chr(&h672a) 258 MsgTxt$ = 会社名が未入力です MsgTxt$ = MsgTxt$ & chr(&h5165)&chr(&h529b)&chr(&h3067)&chr(&h3059)&chr(&h3002) 259 Rem 会社名が未入力です 260 msgbox( MsgTxt$, 48, MsgTtl$) 261 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 262 end Else 263 Else SetCellString WkCL, 1, 2, CoName$ 264 SetCellString WkCL, 1, 2, CoName$ End If 265 End If Rem ( 設立年月 ) Rem ( 設立年月 ) estyr$ = BJHDlg.GetControl("eYR").Text 267 estyr$ = BJHDlg.eYR.Value If Len(estYR$) = 0 Then 268 If Len(estYR$) = 0 Then ページ 4

5 MsgTxt$ = chr(&h8a2d)&chr(&h7acb)&chr(&h5e74)&chr(&h304c)&chr(&h672a) 269 MsgTxt$ = 設立年が未入力です MsgTxt$ = MsgTxt$ & chr(&h5165)&chr(&h529b)&chr(&h3067)&chr(&h3059)&chr(&h3002) 270 Rem 設立年が未入力です 271 msgbox( MsgTxt$, 48, MsgTtl$) 272 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 273 end ElseIf Val(estYR$) < Year(Now()) Then 274 ElseIf Val(estYR$) < Year(Now()) Then MsgTxt$ = chr(&h8a2d)&chr(&h7acb)&chr(&h5e74)&chr(&h304c)&chr(&h0031) 275 MsgTxt$ = 設立年が100 年以上前ですが正しいですか? MsgTxt$ = MsgTxt$ & chr(&h0030)&chr(&h0030)&chr(&h5e74)&chr(&h4ee5)&chr(&h4e0a) 276 MsgTxt$ = MsgTxt$ & chr(&h524d)&chr(&h3067)&chr(&h3059)&chr(&h304c)&chr(&h6b63) 277 MsgTxt$ = MsgTxt$ & chr(&h3057)&chr(&h3044)&chr(&h3067)&chr(&h3059)&chr(&h304b) 278 MsgTxt$ = MsgTxt$ & chr(&hff1f) 279 Rem 設立年が100 年以上前ですが正しいですか? 280 resp% = msgbox( MsgTxt$, 1, MsgTtl$) 281 resp% = msgbox( MsgTxt$, vbyesno, MsgTtl$) If resp% <> 1 Then 282 If resp% <> vbyes Then end 283 end End If 284 End If ElseIf Val(estYR$)>Year(Now()) Then 285 ElseIf Val(estYR$)>Year(Now()) Then MsgTxt$ = chr(&h8a2d)&chr(&h7acb)&chr(&h5e74)&chr(&h306f)&chr(&h4eca) 286 MsgTxt$ = 設立年は今年以前にして下さい MsgTxt$ = MsgTxt$ & chr(&h5e74)&chr(&h4ee5)&chr(&h524d)&chr(&h306b)&chr(&h3057) 287 MsgTxt$ = MsgTxt$ & chr(&h3066)&chr(&h4e0b)&chr(&h3055)&chr(&h3044)&chr(&h3002) 288 Rem 設立年は今年以前にして下さい 289 msgbox( MsgTxt$, 48, MsgTtl$) 290 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 291 end End If 292 End If estmo$ = BJHDlg.GetControl("eMo").Text 293 estmo$ = BJHDlg.eMo.Value If Len(estMo$) = 0 Then 294 If Len(estMo$) = 0 Then MsgTxt$ = chr(&h8a2d)&chr(&h7acb)&chr(&h6708)&chr(&h304c)&chr(&h672a) 295 MsgTxt$ = 設立月が未入力です MsgTxt$ = MsgTxt$ & chr(&h5165)&chr(&h529b)&chr(&h3067)&chr(&h3059)&chr(&h3002) 296 Rem 設立月が未入力です 297 msgbox( MsgTxt$, 48, MsgTtl$) 298 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 299 end ElseIf Val(estMo$) < 1 Or Val(estMo$)>12 Then 300 ElseIf Val(estMo$) < 1 Or Val(estMo$)>12 Then MsgTxt$ = chr(&h8a2d)&chr(&h7acb)&chr(&h6708)&chr(&h304c)&chr(&h0031) 301 MsgTxt$ = 設立月が1から12までの範囲外です MsgTxt$ = MsgTxt$ & chr(&h304b)&chr(&h3089)&chr(&h0031)&chr(&h0032)&chr(&h307e) 302 MsgTxt$ = MsgTxt$ & chr(&h3067)&chr(&h306e)&chr(&h7bc4)&chr(&h56f2)&chr(&h5916) 303 MsgTxt$ = MsgTxt$ & chr(&h3067)&chr(&h3059)&chr(&h3002) 304 Rem 設立月が1から12までの範囲外です 305 msgbox( MsgTxt$, 48, MsgTtl$) 306 msgbox MsgTxt$, 48, MsgTtl$ end 307 end End If 308 End If SetDate "Estb", "FYM", Val(estYR$)*100 + Val(estMo$) 309 SetDate "Estb", "FYM", Val(estYR$)*100 + Val(estMo$) Rem ( 使用開始日 ) Rem ( 使用開始日 ) syr$ = BJHDlg.GetControl("sYR").Text() 311 syr$ = BJHDlg.sYR.Value If Len(sYR$) = 0 Then 312 If Len(sYR$) = 0 Then MsgTxt$ = chr(&h4f7f)&chr(&h7528)&chr(&h958b)&chr(&h59cb)&chr(&h5e74) 313 MsgTxt$ = 使用開始年が未入力です MsgTxt$ = MsgTxt$ & chr(&h304c)&chr(&h672a)&chr(&h5165)&chr(&h529b)&chr(&h3067) 314 MsgTxt$ = MsgTxt$ & chr(&h3059)&chr(&h3002) 315 Rem 使用開始年が未入力です 316 msgbox( MsgTxt$, 48, MsgTtl$) 317 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 318 end ElseIf Val(sYR$) < Val(estYR$) Then 319 ElseIf Val(sYR$) < Val(estYR$) Then MsgTxt$ = chr(&h4f7f)&chr(&h7528)&chr(&h958b)&chr(&h59cb)&chr(&h5e74) 320 MsgTxt$ = 使用開始年が設立年より前になっています MsgTxt$ = MsgTxt$ & chr(&h304c)&chr(&h8a2d)&chr(&h7acb)&chr(&h5e74)&chr(&h3088) 321 MsgTxt$ = MsgTxt$ & chr(&h308a)&chr(&h524d)&chr(&h306b)&chr(&h306a)&chr(&h3063) 322 MsgTxt$ = MsgTxt$ & chr(&h3066)&chr(&h3044)&chr(&h307e)&chr(&h3059)&chr(&h3002) 323 Rem 使用開始年が設立年より前になっています 324 msgbox( MsgTxt$, 48, MsgTtl$) 325 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 326 end ElseIf Val(sYR$)>Year(Now()) Then 327 ElseIf Val(sYR$)>Year(Now()) Then MsgTxt$ = chr(&h4f7f)&chr(&h7528)&chr(&h958b)&chr(&h59cb)&chr(&h5e74) 328 MsgTxt$ = 使用開始年は今年以前にして下さい MsgTxt$ = MsgTxt$ & chr(&h306f)&chr(&h4eca)&chr(&h5e74)&chr(&h4ee5)&chr(&h524d) 329 MsgTxt$ = MsgTxt$ & chr(&h306b)&chr(&h3057)&chr(&h3066)&chr(&h4e0b)&chr(&h3055) 330 MsgTxt$ = MsgTxt$ & chr(&h3044)&chr(&h3002) Rem 使用開始年は今年以前にして下さい msgbox( MsgTxt$, 48, MsgTtl$) 333 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 334 end ページ 5

6 End If 335 End If smo$ = BJHDlg.GetControl("sMO").Text() 336 smo$ = BJHDlg.sMO.Value If Len(sMO$) = 0 Then 337 If Len(sMO$) = 0 Then MsgTxt$ = chr(&h4f7f)&chr(&h7528)&chr(&h958b)&chr(&h59cb)&chr(&h6708) 338 MsgTxt$ = 使用開始月が未入力です MsgTxt$ = MsgTxt$ & chr(&h304c)&chr(&h672a)&chr(&h5165)&chr(&h529b)&chr(&h3067) 339 MsgTxt$ = MsgTxt$ & chr(&h3059)&chr(&h3002) 340 Rem 使用開始月が未入力です 341 msgbox( MsgTxt$, 48, MsgTtl$) 342 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 343 end ElseIf Val(sMO$) < 1 Or Val(sMO$)>12 Then 344 ElseIf Val(sMO$) < 1 Or Val(sMO$)>12 Then MsgTxt$ = chr(&h4f7f)&chr(&h7528)&chr(&h958b)&chr(&h59cb)&chr(&h6708) 345 MsgTxt$ = 使用開始月が1から12までの範囲外です MsgTxt$ = MsgTxt$ & chr(&h304c)&chr(&h0031)&chr(&h304b)&chr(&h3089)&chr(&h0031) 346 MsgTxt$ = MsgTxt$ & chr(&h0032)&chr(&h307e)&chr(&h3067)&chr(&h306e)&chr(&h7bc4) 347 MsgTxt$ = MsgTxt$ & chr(&h56f2)&chr(&h5916)&chr(&h3067)&chr(&h3059)&chr(&h3002) 348 Rem 使用開始月が1から12までの範囲外です 349 msgbox( MsgTxt$, 48, MsgTtl$) 350 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 351 end End If 352 End If If Val(sYR$)*100+ Val(sMO$) < Val(estYR$)*100 + Val(estMo$) Then 353 If Val(sYR$)*100+ Val(sMO$) < Val(estYR$)*100 + Val(estMo$) Then MsgTxt$ = chr(&h4f7f)&chr(&h7528)&chr(&h958b)&chr(&h59cb)&chr(&h5e74) 354 MsgTxt$ = 使用開始年月が設立年月より前になっています MsgTxt$ = MsgTxt$ & chr(&h6708)&chr(&h304c)&chr(&h8a2d)&chr(&h7acb)&chr(&h5e74) 355 MsgTxt$ = MsgTxt$ & chr(&h6708)&chr(&h3088)&chr(&h308a)&chr(&h524d)&chr(&h306b) 356 MsgTxt$ = MsgTxt$ & chr(&h306a)&chr(&h3063)&chr(&h3066)&chr(&h3044)&chr(&h307e) 357 MsgTxt$ = MsgTxt$ & chr(&h3059)&chr(&h3002) 358 Rem 使用開始年月が設立年月より前になっています 359 msgbox( MsgTxt$, 48, MsgTtl$) 360 msgbox MsgTxt$, vbexclamation, MsgTtl$ end 361 end End If 362 End If iniymd$ = DateSerial(sYR$, smo$, 1) 363 iniymd$ = DateSerial(sYR$, smo$, 1) nymd& = DateValue(iniYMD$) nymd& = DateValue(iniYMD$) -1 sfy$ = DateSerial(Year(nYMD&), Month(nYMD&), Day(nYMD&)) 365 sfy$ = DateSerial(Year(nYMD&), Month(nYMD&), Day(nYMD&)) SetDate "Strt", "Date", sfy$ 366 SetDate "Strt", "Date", sfy$ sym$ = Left(sFY$, 4) & Mid(sFY$, 6, 2) 367 sym$ = Left(sFY$, 4) & Mid(sFY$, 6, 2) Rem Rem MsgTtl$ = chr(&h511f)&chr(&h5374)&chr(&h65b9)&chr(&h6cd5)&chr(&h306e) 369 MsgTtl$ = 償却方法の指定確認 MsgTtl$ = MsgTtl$ & chr(&h6307)&chr(&h5b9a)&chr(&h78ba)&chr(&h8a8d) 370 Rem 償却方法の指定確認 ( 有形固定資産 ) Rem 償却方法の指定確認 ( 有形固定資産 ) setcolarray("yuk") 372 setcolarray("yuk") VeriConsAft() 373 VeriConsAft Rem Rem XFDFFolder() 378 XFDFFolder Rem Rem RestoreHeaders() 380 RestoreHeaders ThisComponent.calculate 381 Application.Calculate WkCL.Protect("pwd") 382 WkCL.Protect Password:="pwd" GetMsgTxt$(400) 389 GetMsgTxt$(400) Rem 償却方法につき 次の変更が設定されました 390 Rem 償却方法につき 次の変更が設定されました Rem 変更後ファイルを新規ファイル名で保存しますか? 391 Rem 変更後ファイルを新規ファイル名で保存しますか? resp% = MsgBox(MsgTxt$, 36, MsgTtl$) 392 resp% = MsgBox(MsgTxt$, vbquestion+vbyesno, MsgTtl$) If resp% = 6 then 393 If resp% = vbyes then BJHDlg.GetControl("FSVBox").Model.State = True 178 for Vista 394 BJHDlg.FSVBox.Value = True BJHDlg.Model.Width = BJHDlg.Model.Width BJHDlg.Model.Height = BJHDlg.Model.Height BJHDlg.Height = BJH.Height + 38 BJHDlg.GetControl("DocNMBox").setFocus() 397 BJHDlg.Visible=True 398 GetMsgTxt$(410) 399 GetMsgTxt$(410) Rem 新規ファイル名を ダイアログ最下部 Ⅶのボックスに入力して下さい 400 Rem 新規ファイル名を ダイアログ最下部 Ⅶのボックスに入力して下さい MsgBox(MsgTxt$, 0, MsgTtl$) 401 MsgBox MsgTxt$, vbokonly, MsgTtl$ ページ 6

7 402 BJHDlg.DocNMBox.SetFocus Exit Sub 403 Exit Sub Else 404 Else OnOut 405 OnOut End If 409 End If End Sub 410 End Sub Sub DocStoreAs() 411 Sub mydocstoreas() dim NoArgs() as New com.sun.star.beans.propertyvalue 412 dim odocument As Object, sdcname$, dcols% 413 Dim sdcname$, dcols% odocument = StarDesktop.ActiveFrame.Controller.Model 414 sdcname$ = BJHDlg.GetControl("DocNMBox").Text 415 sdcname$ = BJHDlg.DocNMBox.Value If sdirfile$(1) = sdcname$ Then 416 If sdirfile(1) = sdcname$ Then BJHDlg.GetControl("DocNMBox").Model.BackgroundColor = "&HCCFFFF" 417 BJHDlg.DocNMBox.BackColor = "&HCCFFFF" BJHDlg.GetControl("StoreURL").Label = chr(&h3000)&chr(&h4fdd)&chr(&h5b58) 418 BJHDlg.StoreURL.Caption = 保存 GetMsgTxt$(421) 419 GetMsgTxt$(421) msgbox(msgtxt$, 0, MsgTtl$) 420 msgbox MsgTxt$, 0, MsgTtl$ Else 421 Else Rem 償却累計額保存列の削除 ( 有形固定資産 ) Rem 償却累計額保存列の削除 ( 有形固定資産 ) setcolarray("yuk") 423 setcolarray("yuk") WkYK.UnProtect("pwd") 424 WkYK.UnProtect Password:="pwd" sym$ = CStr(GetDate("Strt","FYM")) 425 sym$ = CStr(GetDate("Strt","FYM")) If BJHDlg.GetControl("OptContinue").Model.State = 0 then 426 If BJHDlg.OptContinue.Value = 0 then SetCellString WkYK, 7, Col_ADINI%, "Book!" & sym$ 427 SetCellString WkYK, 7, Col_ADINI%, "Book!" & sym$ SetCellString WkYK, 7, Ctx_ADINI%, "Tax!" & sym$ 428 SetCellString WkYK, 7, Ctx_ADINI%, "Tax!" & sym$ dcols% = Col_AnoYM%-Ctx_RevACQ% dcols% = Col_AnoYM%-Ctx_RevACQ%-1 WkYK.Columns.removeByIndex(Ctx_RevACQ%, dcols%) 430 WkYK.Range(RNM$(1, Ctx_RevACQ%, 1, dcols%)).entirecolumn.delete End If 431 End If WkYK.Protect("pwd") 432 WkYK.Protect Password:="pwd" Rem 償却累計額保存列の削除 ( 無形固定資産 ) Rem 償却累計額保存列の削除 ( 無形固定資産 ) setcolarray("muk") 434 setcolarray("muk") WkMK.UnProtect("pwd") 435 WkMK.UnProtect Password:="pwd" If BJHDlg.GetControl("OptContinue").Model.State = 0 then 436 If BJHDlg.OptContinue.Value = 0 then SetCellString WkMK, 7, Col_ADINI%, "Book!" & sym$ 437 SetCellString WkMK, 7, Col_ADINI%, "Book!" & sym$ SetCellString WkMK, 7, Ctx_ADINI%, "Tax!" & sym$ 438 SetCellString WkMK, 7, Ctx_ADINI%, "Tax!" & sym$ dcols% = Col_AnoYM%-Ctx_RevACQ% dcols% = Col_AnoYM%-Ctx_RevACQ%-1 WkMK.Columns.removeByIndex(Ctx_RevACQ%, dcols%) 440 WkMK.Range(RNM$(1, Ctx_RevACQ%, 1, dcols%)).entirecolumn.delete End If 441 End If WkMK.Protect("pwd") 442 WkMK.Protect Password:="pwd" Rem Rem sdcname$ = sdirfile$(0) & sdcname$ 444 sdcname$ = sdirfile(0) & sdcname$ odocument.storeasurl(sdcname$, NoArgs()) 445 ActiveWorkbook.SaveAs Filename:=sDcName$ BJHDlg.GetControl("StoreURL").Label = chr(&h4fdd)&chr(&h5b58)&chr(&h5b8c)&chr(&h4e86) 446 BJHDlg.StoreURL.Caption = 保存完了 BJHDlg.GetControl("DocNMBox").Model.BackgroundColor = "&HFFFFFF" 447 BJHDlg.DocNMBox.BackColor = "&HFFFFFF" GetMsgTxt$(420) 448 GetMsgTxt$(420) msgbox(msgtxt$, 0, MsgTtl$) 449 msgbox MsgTxt$, 0, MsgTtl$ End If 450 End If End Sub 451 End Sub Sub StoreURLChg() 452 Sub StoreURLChg() BJHDlg.GetControl("DocNMBox").Model.BackgroundColor = "&HFFC0CB" 453 BJHDlg.DocNMBox.BackColor = "&HFFC0CB" BJHDlg.GetControl("StoreURL").Label = chr(&h4fdd)&chr(&h5b58)&chr(&h958b)&chr(&h59cb) 454 BJHDlg.StoreURL.Caption = 保存開始 End Sub 455 End Sub Function WhatClsChg$() 456 Function WhatClsChg$() dim i%, sbch$, stch$, sbwd$, stwd$, sparrow$ 457 dim i%, sbch$, stch$, sbwd$, stwd$, sparrow$ sbwd$ = chr(&h0028)&chr(&h4f1a)&chr(&h8a08)&chr(&h0029)&chr(&hff1a) ( 会計 ): 458 sbwd$ = ( 会計 ): stwd$ = chr(&h0028)&chr(&h7a0e)&chr(&h52d9)&chr(&h0029)&chr(&hff1a) ( 税務 ): 459 stwd$ = ( 税務 ) sparrow$ = Chr(&H0020)&Chr(&H2794)&Chr(&H0020) 460 Sparrow$ = " " WhatClsChg$ = "" 461 WhatClsChg$ = "" For i% = 0 To For i% = 0 To 7 sbch$ = BCH(i%).Text 463 sbch$ = BCH(i%).Value stch$ = TCH(i%).Text 464 stch$ = TCH(i%).Value If CellString(WkCL, 11+i%, 2) <> sbch$ Then 465 If CellString(WkCL, 11+i%, 2) <> sbch$ Then If WhatClsChg$ = "" Then 466 If WhatClsChg$ = "" Then WhatClsChg$ = ClassNM$(i%) &sbwd$ &sbch$ & sparrow$ 467 WhatClsChg$ = ClassNM$(i%) &sbwd$ &sbch$ & sparrow$ WhatClsChg$ = WhatClsChg$ &CellString(WkCL, 11+i%, 2)&Chr(13) 468 WhatClsChg$ = WhatClsChg$ &CellString(WkCL, 11+i%, 2)&Chr(13) ページ 7

8 Else 469 Else WhatClsChg$ = WhatClsChg$ &ClassNM$(i%) &sbwd$ &sbch$ & sparrow$ 470 WhatClsChg$ = WhatClsChg$ &ClassNM$(i%) &sbwd$ &sbch$ & sparrow$ WhatClsChg$ = WhatClsChg$ &CellString(WkCL, 11+i%, 2) &Chr(13) 471 WhatClsChg$ = WhatClsChg$ &CellString(WkCL, 11+i%, 2) &Chr(13) End If 472 End If End If 473 End If If CellString(WkCL, 11+i%, 4) <> stch$ Then 474 If CellString(WkCL, 11+i%, 4) <> stch$ Then If WhatClsChg$ = "" Then 475 If WhatClsChg$ = "" Then WhatClsChg$ = ClassNM$(i%) &stwd$ &stch$ & sparrow$ 476 WhatClsChg$ = ClassNM$(i%) &stwd$ &stch$ & sparrow$ WhatClsChg$ = WhatClsChg$ &CellString(WkCL, 11+i%, 4)&Chr(13) 477 WhatClsChg$ = WhatClsChg$ &CellString(WkCL, 11+i%, 4)&Chr(13) Else 478 Else WhatClsChg$ = WhatClsChg$ &ClassNM$(i%) &stwd$ &stch$ & sparrow$ 479 WhatClsChg$ = WhatClsChg$ &ClassNM$(i%) &stwd$ &stch$ & sparrow$ WhatClsChg$ = WhatClsChg$ &CellString(WkCL, 11+i%, 4)&Chr(13) 480 WhatClsChg$ = WhatClsChg$ &CellString(WkCL, 11+i%, 4)&Chr(13) End If 481 End If End If 482 End If Next i% 483 Next i% End Function 484 End Function Sub VeriConsAft() 485 Sub VeriConsAft() dim i% 486 dim i% For i% = 0 to For i% = 0 to 6 If BDM(i%).Text = BCH(i%).Text And TDM(i%).Text = TCH(i%).Text And _ 488 CB(i%).Model.State = CBCH(i%).Model.State Then 489 Rem Do Nothing 490 Else 491 SetCellString WkCL, 11 + i%, 2, BDM(i%).Text 492 SetCellString WkCL, 11 + i%, 2, BDM(i%).Value SetCellString WkCL, 11 + i%, 4, TDM(i%).Text 493 SetCellString WkCL, 11 + i%, 4, TDM(i%).Value SetCellString WkCL, 11 + i%, 6, CB(i%).Model.State 494 SetCellString WkCL, 11 + i%, 6, CB(i%).Value End If 495 Next i% 496 Next i% End Sub 497 End Sub Sub VeriCons() 498 Sub VeriCons(ByVal h%) dim h%, swd$, resp% 499 dim swd$, resp% h% = Val(Right(BJHDlg.getControl("SorNM").Text,1)) 500 If BJHDlg.FBX.Value = False then 501 Exit Sub 502 End If If BDM(h%).Text = BCH(h%).Text And TDM(h%).Text = TCH(h%).Text And _ 503 If BDM(h%).Value = BCH(h%).Value And TDM(h%).Value = TCH(h%).Value And _ CB(h%).Model.State = CBCH(h%).Model.State Then 504 CB(h%).Value = CBCH(h%).Value Then Exit Sub 505 Exit Sub End If 506 End If swd$ = chr(&h8a72)&chr(&h5f53)&chr(&h306a)&chr(&h3057) 該当なし 507 swd$ = 該当なし Rem Rem If BJHDlg.GetControl("OptContinue").Model.State = 1 then 509 If BJHDlg.OptContinue.Value = True then If FitSum@(WkYK, h%, 1, Col_AQAmt%, Col_AQAmt%) > 0 Then 510 If FitSum@(WkYK,Clng( h%), 1, Col_AQAmt%, Col_AQAmt%) > 0 Then CLS(h%).Model.BackgroundColor = "&HFFC0CB" 511 CLS(h%).BackColor = "&HFFC0CB" Rem MsgTtl$ = 償却方法変更チェック 512 Rem MsgTtl$ = 償却方法変更チェック If BDM(h%).Text = swd$ Or TDM(h%).Text = swd$ Then 会計 or 税務 : 該 513 If BDM(h%).Value = swd$ Or TDM(h%).Value = swd$ Then GetMsgTxt$(100) 514 GetMsgTxt$(100) Rem 過年度の減価償却データがありますので 該当なしへの変更はできません 515 Rem 過年度の減価償却データがありますので 該当なしへの変更はできません MsgBox(MsgTxt$, 16, MsgTtl$) 516 MsgBox MsgTxt$, 16, MsgTtl$ Else 517 Else If (CellString(WkCL, 22, 2) = FiscalYMD$ AND CellString(WkCL, 22, 3) = "T") AND _ 518 If (CellString(WkCL, 22, 2) = FiscalYMD$ AND CellString(WkCL, 22, 3) = "T") AND _ (CellString(WkCL, 23, 2) = FiscalYMD$ AND CellString(WkCL, 23, 3) = "T") Then 519 (CellString(WkCL, 23, 2) = FiscalYMD$ AND CellString(WkCL, 23, 3) = "T") Then Rem ---( 償却計算後 WkCLのセルB22は更新されるため これが期末であることを確認 ) 520 Rem ---( 償却計算後 WkCLのセルB22は更新されるため これが期末であることを確認 ) If BDM(h%).Text <> BCH(h%).Text Then 521 If BDM(h%).Value <> BCH(h%).Value Then GetMsgTxt$(110) 522 GetMsgTxt$(110) Rem 過年度の減価償却データがありますので 償却方法の変更は会計方針の 523 Rem 過年度の減価償却データがありますので 償却方法の変更は会計方針の Rem 変更に該当します そのために必要な承認等の手続は済んでいますか? 524 Rem 変更に該当します そのために必要な承認等の手続は済んでいますか? ElseIf TDM(h%).Text <> TCH(h%).Text Then 525 ElseIf TDM(h%).Value <> TCH(h%).Value Then GetMsgTxt$(111) 526 GetMsgTxt$(111) Rem 過年度の減価償却データがありますので 償却方法の変更は税務償却方法の 527 Rem 過年度の減価償却データがありますので 償却方法の変更は税務償却方法の Rem 変更に該当します そのために必要な届出等の手続は済んでいますか? 528 Rem 変更に該当します そのために必要な届出等の手続は済んでいますか? End If 529 End If resp% = MsgBox(MsgTxt$, 36, MsgTtl$) 530 resp% = MsgBox(MsgTxt$, 36, MsgTtl$) If resp% = 6 Then 531 If resp% = 6 Then CLS(h%).Model.BackgroundColor = "&HC0E0FF" 532 CLS(h%).BackColor = "&HC0E0FF" Exit SUb 533 Exit SUb End If 534 End If Else 535 Else ページ 8

9 GetMsgTxt$(105) 536 GetMsgTxt$(105) Rem 減価償却方法の変更は事業年度末での計算が完了している場合に 537 Rem 減価償却方法の変更は事業年度末での計算が完了している場合に Rem だけ行なうことができます 変更後償却方法の適用年度の直前の 538 Rem だけ行なうことができます 変更後償却方法の適用年度の直前の Rem 事業年度末の減価償却計算を有形 無形の両方とも完了して下さい 539 Rem 事業年度末の減価償却計算を有形 無形の両方とも完了して下さい MsgBox(MsgTxt$, 16, MsgTtl$) 540 MsgBox MsgTxt$, 16, MsgTtl$ End If 541 End If End If 542 End If BDM(h%).Text = BCH(h%).Text 543 BDM(h%).Value = BCH(h%).Value TDM(h%).Text = TCH(h%).Text 544 TDM(h%).Value = TCH(h%).Value CB(h%).Model.State = CBCH(h%).Model.State 545 CB(h%).Value = CBCH(h%).Value CLS(h%).Model.BackgroundColor = "&HF0EBB6" 546 CLS(h%).BackColor = "&HC0E0FF" Else 547 Else If BDM(h%).Text = swd$ Then 548 If BDM(h%).Value = swd$ Then If TDM(h%).Text = swd$ Then 549 If TDM(h%).Value = swd$ Then CB(h%).Model.State = False 550 CB(h%).Value = False FitRowHide WkYK, CStr(h%), 1, 1, False 会計 税務 : 償 551 FitRowHide WkYK, CStr(h%), 1, 1, False Else 552 Else CLS(h%).Model.BackgroundColor = "&HFFC0CB" 553 CLS(h%).BackColor = "&HFFC0CB" GetMsgTxt$ (310) 554 GetMsgTxt$ (310) MsgBox MsgTxt$, vbexclamation, MsgTtl$ 555 MsgBox MsgTxt$, vbexclamation, MsgTtl$ Rem 会計償却方法も指定するか 会計 税務とも 該当なし にして下さい 556 Rem 会計償却方法も指定するか 会計 税務とも 該当なし にして下さい CLS(h%).Model.BackgroundColor = "&HC0E0FF" 557 CLS(h%).BackColor = "&HC0E0FF" End If 558 End If Else 559 Else If TDM(h%).Text = swd$ Then 560 If TDM(h%).Value = swd$ Then CLS(h%).Model.BackgroundColor = "&HFFC0CB" 561 CLS(h%).BackColor = "&HFFC0CB" GetMsgTxt$ (300) 562 GetMsgTxt$ (300) MsgBox MsgTxt$, vbexclamation, MsgTtl$ 563 MsgBox MsgTxt$, vbexclamation, MsgTtl$ Rem 税務償却方法も指定するか 会計 税務とも 該当なし にして下さい 564 Rem 税務償却方法も指定するか 会計 税務とも 該当なし にして下さい CLS(h%).Model.BackgroundColor = "&HC0E0FF" 565 CLS(h%).BackColor = "&HC0E0FF" Else 566 Else FitRowHide WkYK, CStr(h%), 1, 1, True 567 FitRowHide WkYK, CStr(h%), 1, 1, True If BDM(h%).Text = TDM(h%).Text Then 568 If BDM(h%).Value = TDM(h%).Value Then VeriCB (h%) 569 VeriCB (h%) Else 570 Else CB(h%).Model.State = True 571 CB(h%).Value = True End If 572 End If End If 573 End If End If 574 End If End If 575 End If Else ( 新規開始の場 576 ' Else If FitSum@(WkYK, h%, 1, Col_AQAmt%, Col_AQAmt%) > 0 Then 577 If FitSum@(WkYK,Clng( h%), 1, Col_AQAmt%, Col_AQAmt%) > 0 Then If BDM(h%).Text = swd$ Then 会計 : 該当なし 578 If BDM(h%).Value = swd$ Then CLS(h%).Model.BackgroundColor = "&HFFC0CB" 579 CLS(h%).BackColor = "&HFFC0CB" If TDM(h%).Text = swd$ Then 税務 : 該当なし 580 If TDM(h%).Value = swd$ Then CB(h%).Model.State = False 581 CB(h%).Value = False 582 GetMsgTxt$(200) 583 GetMsgTxt$(200) Rem 償却方法変更チェック 584 Rem 償却方法変更チェック Rem 過年度取得の償却資産データが入力されています 585 Rem 過年度取得の償却資産データが入力されています Rem 一行だけ残して これらの他の行を削除しますか? 586 Rem 一行だけ残して これらの他の行を削除しますか? resp% = MsgBox(MsgTxt$, 36, MsgTtl$) 587 resp% = MsgBox(MsgTxt$, 36, MsgTtl$) If resp% = 6 then 588 If resp% = 6 then WkCL.UnProtect("pwd") 589 WkYK.UnProtect Password:="pwd" FitRowDel WkYK, Clng(h%), FitRowDel WkYK, Clng(h%), 1 WkCL.Protect("pwd") 591 WkYK.Protect Password:="pwd" End If 592 End If Else 593 Else GetMsgTxt$ (310) 594 GetMsgTxt$ (310) MsgBox MsgTxt$, vbexclamation, MsgTtl$ 595 MsgBox MsgTxt$, vbexclamation, MsgTtl$ Rem 会計償却方法も指定するか 会計 税務とも 該当なし にして下さい 596 Rem 会計償却方法も指定するか 会計 税務とも 該当なし にして下さい End If 597 End If CLS(h%).Model.BackgroundColor = "&HC0E0FF" 598 CLS(h%).BackColor = "&HC0E0FF" Else 会計 : 該当あり 599 Else If BDM(h%).Text <> BCH(h%).Text Or TDM(h%).Text <> TCH(h%).Text Then 会計または税 600 If BDM(h%).Value <> BCH(h%).Value Or TDM(h%).Value <> TCH(h%).Value Then FitRowHide WkYK, CStr(h%), 1, 1, True 601 FitRowHide WkYK, CStr(h%), 1, 1, True If BDM(h%).Text = TDM(h%).Text Then 会計 税務 : 償 602 If BDM(h%).Value = TDM(h%).Value Then ページ 9

10 VeriCB (h%) 603 VeriCB (h%) Else 会計 税務 : 償 604 Else CB(h%).Model.State = True 605 CB(h%).Value = True End If 606 End If End If 607 End If End If 608 End If Else 609 Else If BDM(h%).Text = swd$ Then 会計 : 該当なし 610 If BDM(h%).Value = swd$ Then If TDM(h%).Text = swd$ Then 税務 : 該当なし 611 If TDM(h%).Value = swd$ Then CB(h%).Model.State = False 612 CB(h%).Value = False FitRowHide WkYK, CStr(h%), 1, 1, True 613 FitRowHide WkYK, CStr(h%), 1, 1, True Else 614 Else CLS(h%).Model.BackgroundColor = "&HFFC0CB" 615 CLS(h%).BackColor = "&HFFC0CB" GetMsgTxt$ (310) 616 GetMsgTxt$ (310) MsgBox MsgTxt$, vbexclamation, MsgTtl$ 617 MsgBox MsgTxt$, vbexclamation, MsgTtl$ Rem 会計償却方法も指定するか 会計 税務とも 該当なし にして下さい 618 Rem 会計償却方法も指定するか 会計 税務とも 該当なし にして下さい CLS(h%).Model.BackgroundColor = "&HC0E0FF" 619 CLS(h%).BackColor = "&HC0E0FF" End If 620 End If Else 会計 : 該当あり 621 Else If TDM(h%).Text = swd$ Then 会計 税務 : 償 622 If TDM(h%).Value = swd$ Then CLS(h%).Model.BackgroundColor = "&HFFC0CB" 623 CLS(h%).BackColor = "&HFFC0CB" GetMsgTxt$ (300) 会計 税務 : 償 624 GetMsgTxt$ (300) MsgBox MsgTxt$, vbexclamation, MsgTtl$ 625 MsgBox MsgTxt$, vbexclamation, MsgTtl$ Rem 税務償却方法も指定するか 会計 税務とも 該当なし にして下さい 626 Rem 税務償却方法も指定するか 会計 税務とも 該当なし にして下さい CLS(h%).Model.BackgroundColor = "&HC0E0FF" 627 CLS(h%).BackColor = "&HC0E0FF" Else 628 Else FitRowHide WkYK, CStr(h%), 1, 1, True 629 FitRowHide WkYK, CStr(h%), 1, 1, True If BDM(h%).Text = TDM(h%).Text Then 630 If BDM(h%).Value = TDM(h%).Value Then VeriCB (h%) 631 VeriCB (h%) Else 632 Else CB(h%).Model.State = True 633 CB(h%).Value = True End If 634 End If End If 635 End If End If 636 End If End If 637 End If End If 638 End If End Sub 639 End Sub Sub VeriCB(ByVal h%) 640 Sub VeriCB(ByVal h%) Dim resp% 641 Dim resp% CLS(h%).Model.BackgroundColor = "&HFFC0CB" 642 CLS(h%).BackColor = "&HFFC0CB" GetMsgTxt$ (210) 643 GetMsgTxt$ (210) Rem MsgTtl$ = " 不一致欄の処理 " 644 Rem MsgTtl$ = " 不一致欄の処理 " Rem " 会計 税務で同じ償却方法が選択されました " & CHr(13) 645 Rem " 会計 税務で同じ償却方法が選択されました " & CHr(13) Rem " この場合 耐用年数 残存価額等すべて一致 " & Chr(13) 646 Rem " この場合 耐用年数 残存価額等すべて一致 " & Chr(13) Rem " するときだけ 不一致 Boxを空欄にします " 647 Rem " するときだけ 不一致 Boxを空欄にします " resp% = MsgBox(MsgTxt$, 36, MsgTtl$) 648 resp% = MsgBox(MsgTxt$, 36, MsgTtl$) If resp% = 6 Then 649 If resp% = 6 Then CB(h%).Model.State = False 650 CB(h%).Value = False Else 651 Else CB(h%).Model.State = True 652 CB(h%).Value = True End If 653 End If CLS(h%).Model.BackgroundColor = "&HC0E0FF" 654 CLS(h%).BackColor = "&HC0E0FF" End Sub 655 End Sub Sub OnOut() 656 Sub OnOut() If BJHDlg.GetControl("FSVBox").Model.State = True Then 657 If BJHDlg.FSVBox.Value = True Then If sdirfile(1) = BJHDlg.getCOntrol("DocNMBox").Text Then 658 If sdirfile(1) = BJHDlg.DocNMBox.Value Then GetMsgTxt$ (430) 659 GetMsgTxt$ (430) Rem ファイルは保存されませんでした 660 Rem ファイルは保存されませんでした MsgBox MsgTxt$, 0, MsgTtl$ 661 MsgBox MsgTxt$, vbokonly, MsgTtl$ End If 662 End If End If 663 End If BJHDlg.endExecute() 664 BJHDlg.Hide End Sub 665 End Sub Sub DefDPRMtd() 666 Sub DefDPRMtd() dim i% 667 dim i% For i% = 0 To For i% = 0 To 7 BkDMtd$(i%) =CellString(WkCL, 11+i%, 3) 669 BkDMtd(i%) =CellString(WkCL, 11+i%, 3) ページ 10

11 TxDMtd$(i%) =CellString(WkCL, 11+i%, 5) 670 TxDMtd(i%) =CellString(WkCL, 11+i%, 5) IsBkTxDiff(i%)=CellString(WkCL, 11+i%, 6) 671 IsBkTxDiff(i%) = CellString(WkCL, 11 + i%, 6) Next i% 672 Next i% BkDMtd$(8) ="ABM" 673 BkDMtd(8) ="ABM" TxDMtd$(8) ="ABM" 674 TxDMtd(8) ="ABM" IsBkTxDiff(8)="0" 675 IsBkTxDiff(8)=False End Sub 676 End Sub Sub GetMsgTxt$(ByVal msgnum%) 677 Sub GetMsgTxt(ByVal msgnum%) dim swd$ 678 dim swd$ MsgTtl$ = chr(&h511f)&chr(&h5374)&chr(&h65b9)&chr(&h6cd5)&chr(&h5909) 679 MsgTtl$ = 償却方法変更チェック MsgTtl$ = MsgTtl$ & chr(&h66f4)&chr(&h30c1)&chr(&h30a7)&chr(&h30c3)&chr(&h30af) 680 Rem 償却方法変更チェック 681 Select Case msgnum% 682 Select Case msgnum% Case Case 10 MsgTtl$ = chr(&h8a2d)&chr(&h5b9a)&chr(&h767b)&chr(&h9332)&chr(&h65b9) 684 MsgTtl$ = 設定登録方法の確認 MsgTtl$ = MsgTtl$ & chr(&h6cd5)&chr(&h306e)&chr(&h78ba)&chr(&h8a8d) 685 Rem 設定登録方法の確認 686 MsgTxt$ = Chr(&H00A0)&chr(&H2165)&chr(&H306E)&chr(&H8A2D)&chr(&H5B9A) 687 MsgTxt$ = Ⅵの設定登録方法として & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h767b)&chr(&h9332)&chr(&h65b9)& chr(&h6cd5)&chr(&h3068) 688 MsgTxt$ = MsgTxt$ & chr(&h3057)&chr(&h3066)&chr(&h3001)&chr(13) 689 Rem Ⅵの設定登録方法として 690 MsgTxt$ = MsgTxt$ & chr(&h300c)&chr(&h65b0)&chr(&h898f)&chr(&h5c0e)&chr(&h5165) 691 MsgTxt$ = MsgTxt$ & 新規導入 転用開始の場合 MsgTxt$ = MsgTxt$ & chr(&h30fb)&chr(&h8ee2)&chr(&h7528)&chr(&h958b)&chr(&h59cb) 692 MsgTxt$ = MsgTxt$ & chr(&h306e)&chr(&h5834)&chr(&h5408)&chr(&h300d) 693 Rem 新規導入 転用開始の場合 694 MsgTxt$ = MsgTxt$ & chr(&h304c)&chr(&h9078)&chr(&h629e)&chr(&h3055)&chr(&h308c) 695 MsgTxt$ = MsgTxt$ & が選択されました & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h307e)&chr(&h3057)&chr(&h305f)&chr(&h3002)&chr(13)&chr(13) 696 Rem が選択されました 697 MsgTxt$ = MsgTxt$ & chr(&h3053)&chr(&h306e)&chr(&h30aa)&chr(&h30d7)&chr(&h30b7) 698 MsgTxt$ = MsgTxt$ & このオプションでの設定完了時の操作は & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h30e7)&chr(&h30f3)&chr(&h3067)&chr(&h306f)&chr(&h3001) 699 MsgTxt$ = MsgTxt$ & chr(&h8a2d)&chr(&h5b9a)&chr(&h5b8c)&chr(&h4e86)&chr(&h6642) 700 MsgTxt$ = MsgTxt$ & chr(&h306b)&chr(&h3001)&chr(13) 701 Rem このオプションでの設定完了時の操作は 702 MsgTxt$ = MsgTxt$ & chr(&h8ee2)&chr(&h7528)&chr(&h958b)&chr(&h59cb)&chr(&h306e) 703 MsgTxt$ = MsgTxt$ & 転用開始の場合は 必ず 新規ファイル名で保存します & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h5834)&chr(&h5408)&chr(&h306f)&chr(&h3001)&chr(&h5fc5) 704 MsgTxt$ = MsgTxt$ & chr(&h305a)&chr(&h3001)&chr(&h65b0)&chr(&h898f)&chr(&h30d5) 705 MsgTxt$ = MsgTxt$ & chr(&h30a1)&chr(&h30a4)&chr(&h30eb)&chr(&h540d)&chr(&h3067) 706 MsgTxt$ = MsgTxt$ & chr(&h4fdd)&chr(&h5b58)&chr(&h3057)&chr(&h307e)&chr(&h3059) 707 MsgTxt$ = MsgTxt$ & chr(&h3002)&chr(13) 708 Rem 転用開始の場合は 必ず 新規ファイル名で保存します 709 MsgTxt$ = MsgTxt$ & chr(&h4ed6)&chr(&h65b9)&chr(&h3001)&chr(&h65b0)&chr(&h898f) 710 MsgTxt$ = MsgTxt$ & 他方 新規導入の場合は どちらもOKです すなわち & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h5c0e)&chr(&h5165)&chr(&h306e)&chr(&h5834)&chr(&h5408) 711 MsgTxt$ = MsgTxt$ & chr(&h306f)&chr(&h3001)&chr(&h3069)&chr(&h3061)&chr(&h3089) 712 MsgTxt$ = MsgTxt$ & chr(&h3082)&chr(&hff2f)&chr(&hff2b)&chr(&h3067)&chr(&h3059) 713 MsgTxt$ = MsgTxt$ & chr(&h3002)&chr(&h3059)&chr(&h306a)&chr(&h308f)&chr(&h3061) 714 MsgTxt$ = MsgTxt$ & chr(&h3001)&chr(13) 715 Rem 他方 新規導入の場合は どちらもOKです すなわち 716 MsgTxt$ = MsgTxt$ & chr(&h65b0)&chr(&h898f)&chr(&h30d5)&chr(&h30a1)&chr(&h30a4) 717 MsgTxt$ = MsgTxt$ & 新規ファイル名での保存 ファイル名を変更しない & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h30eb)&chr(&h540d)&chr(&h3067)&chr(&h306e)&chr(&h4fdd) 718 MsgTxt$ = MsgTxt$ & chr(&h5b58)&chr(&h3001)&chr(&h30d5)&chr(&h30a1)&chr(&h30a4) 719 MsgTxt$ = MsgTxt$ & chr(&h30eb)&chr(&h540d)&chr(&h3092)&chr(&h5909)&chr(&h66f4) 720 MsgTxt$ = MsgTxt$ & chr(&h3057)&chr(&h306a)&chr(&h3044)&chr(13) 721 Rem 新規ファイル名での保存 ファイル名を変更しない 722 MsgTxt$ = MsgTxt$ & chr(&h4e0a)&chr(&h66f8)&chr(&h304d)&chr(&h4fdd)&chr(&h5b58) 723 MsgTxt$ = MsgTxt$ & 上書き保存のどちらでもOKです MsgTxt$ = MsgTxt$ & chr(&h306e)&chr(&h3069)&chr(&h3061)&chr(&h3089)&chr(&h3067) 724 MsgTxt$ = MsgTxt$ & chr(&h3082)&chr(&hff2f)&chr(&hff2b)&chr(&h3067)&chr(&h3059) 725 MsgTxt$ = MsgTxt$ & chr(&h3002) 726 Rem 上書き保存のどちらでもOKです 727 Case Case 100 MsgTxt$ = chr(&h8a2d)&chr(&h5b9a)&chr(&h767b)&chr(&h9332)&chr(&h65b9) 729 MsgTxt$ = 設定登録方法として 従来からの使用継続の場合 が選択されています & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h6cd5)&chr(&h3068)&chr(&h3057)&chr(&h3066)&chr(&h3001) 730 MsgTxt$ = MsgTxt$ & chr(&h300c)&chr(&h5f93)&chr(&h6765)&chr(&h304b)&chr(&h3089) 731 MsgTxt$ = MsgTxt$ & chr(&h306e)&chr(&h4f7f)&chr(&h7528)&chr(&h7d99)&chr(&h7d9a) 732 MsgTxt$ = MsgTxt$ & chr(&h306e)&chr(&h5834)&chr(&h5408)&chr(&h300d)&chr(&h304c) 733 MsgTxt$ = MsgTxt$ & chr(&h9078)&chr(&h629e)&chr(&h3055)&chr(&h308c)&chr(&h3066) 734 MsgTxt$ = MsgTxt$ & chr(&h3044)&chr(&h307e)&chr(&h3059)&chr(&h3002)&chr(13) Rem 設定登録方法として 従来からの使用継続の場合 が選択されています ページ 11

12 MsgTxt$ = MsgTxt$ & chr(&h3053)&chr(&h306e)&chr(&h30e2)&chr(&h30fc)&chr(&h30c9) 737 MsgTxt$ = MsgTxt$ & このモードでは 過年度の減価償却データがありますので 該当なし & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h3067)&chr(&h306f)&chr(&h3001)&chr(&h904e)&chr(&h5e74) 738 MsgTxt$ = MsgTxt$ & chr(&h5ea6)&chr(&h306e)&chr(&h6e1b)&chr(&h4fa1)&chr(&h511f) 739 MsgTxt$ = MsgTxt$ & chr(&h5374)&chr(&h30c7)&chr(&h30fc)&chr(&h30bf)&chr(&h304c) 740 MsgTxt$ = MsgTxt$ & chr(&h3042)&chr(&h308a)&chr(&h307e)&chr(&h3059)&chr(&h306e) 741 MsgTxt$ = MsgTxt$ & chr(&h3067)&chr(&h3001)&chr(&h300c)&chr(&h8a72)&chr(&h5f53) 742 MsgTxt$ = MsgTxt$ & chr(&h306a)&chr(&h3057)&chr(&h300d)&chr(13) Rem このモードでは 過年度の減価償却データがありますので 該当なし MsgTxt$ = MsgTxt$ & chr(&h3078)&chr(&h306e)&chr(&h5909)&chr(&h66f4)&chr(&h306f) 745 MsgTxt$ = MsgTxt$ & への変更はできません & Chr(13) & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h3067)&chr(&h304d)&chr(&h307e)&chr(&h305b)&chr(&h3093) 746 MsgTxt$ = MsgTxt$ & chr(&h3002)&chr(13)&chr(13) Rem への変更はできません MsgTxt$ = MsgTxt$ & chr(&h8a2d)&chr(&h5b9a)&chr(&h767b)&chr(&h9332)&chr(&h65b9) 749 MsgTxt$ = MsgTxt$ & 設定登録方法が適切でない場合は ダイアログ下部のセクションⅥで & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h6cd5)&chr(&h304c)&chr(&h9069)&chr(&h5207)&chr(&h3067) 750 MsgTxt$ = MsgTxt$ & chr(&h306a)&chr(&h3044)&chr(&h5834)&chr(&h5408)&chr(&h306f) 751 MsgTxt$ = MsgTxt$ & chr(&h3001)&chr(&h30c0)&chr(&h30a4)&chr(&h30a2)&chr(&h30ed) 752 MsgTxt$ = MsgTxt$ & chr(&h30b0)&chr(&h4e0b)&chr(&h90e8)&chr(&h306e)&chr(&h30bb) 753 MsgTxt$ = MsgTxt$ & chr(&h30af)&chr(&h30b7)&chr(&h30e7)&chr(&h30f3)&chr(&h2165) 754 MsgTxt$ = MsgTxt$ & chr(&h3067)&chr(13) Rem 設定登録方法が適切でない場合は ダイアログ下部のセクションⅥで MsgTxt$ = MsgTxt$ & chr(&h9069)&chr(&h5207)&chr(&h306a)&chr(&h65b9)&chr(&h6cd5) 757 MsgTxt$ = MsgTxt$ & 適切な方法に変更します MsgTxt$ = MsgTxt$ & chr(&h306b)&chr(&h5909)&chr(&h66f4)&chr(&h3057)&chr(&h307e) 758 MsgTxt$ = MsgTxt$ & chr(&h3059)&chr(&h3002) Rem 適切な方法に変更します Case Case 105 MsgTxt$ = chr(&h6e1b)&chr(&h4fa1)&chr(&h511f)&chr(&h5374)&chr(&h65b9) 762 MsgTxt$ = 減価償却方法の変更は事業年度末での計算が完了している場合に & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h6cd5)&chr(&h306e)&chr(&h5909)&chr(&h66f4)&chr(&h306f) 763 MsgTxt$ = MsgTxt$ & chr(&h4e8b)&chr(&h696d)&chr(&h5e74)&chr(&h5ea6)&chr(&h672b) 764 MsgTxt$ = MsgTxt$ & chr(&h3067)&chr(&h306e)&chr(&h8a08)&chr(&h7b97)&chr(&h304c) 765 MsgTxt$ = MsgTxt$ & chr(&h5b8c)&chr(&h4e86)&chr(&h3057)&chr(&h3066)&chr(&h3044) 766 MsgTxt$ = MsgTxt$ & chr(&h308b)&chr(&h5834)&chr(&h5408)&chr(&h306b)&chr(13) Rem 減価償却方法の変更は事業年度末での計算が完了している場合に MsgTxt$ = MsgTxt$ & chr(&h3060)&chr(&h3051)&chr(&h884c)&chr(&h306a)&chr(&h3046) 769 MsgTxt$ = MsgTxt$ & だけ行なうことができます 変更後償却方法の適用年度の直前の & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h3053)&chr(&h3068)&chr(&h304c)&chr(&h3067)&chr(&h304d) 770 MsgTxt$ = MsgTxt$ & chr(&h307e)&chr(&h3059)&chr(&h3002)&chr(&h5909)&chr(&h66f4) 771 MsgTxt$ = MsgTxt$ & chr(&h5f8c)&chr(&h511f)&chr(&h5374)&chr(&h65b9)&chr(&h6cd5) 772 MsgTxt$ = MsgTxt$ & chr(&h9069)&chr(&h7528)&chr(&h5e74)&chr(&h5ea6)&chr(&h306e) 773 MsgTxt$ = MsgTxt$ & chr(&h76f4)&chr(&h524d)&chr(&h4e8b)&chr(&h696d)&chr(13) Rem だけ行なうことができます 変更後償却方法の適用年度の直前の MsgTxt$ = MsgTxt$ & chr(&h5e74)&chr(&h5ea6)&chr(&h672b)&chr(&h306e) 776 MsgTxt$ = MsgTxt$ & 事業年度末の減価償却計算を有形 無形の両方とも完了して下さい MsgTxt$ = MsgTxt$ & chr(&h511f)&chr(&h5374)&chr(&h8a08)&chr(&h7b97)&chr(&h3092) 777 MsgTxt$ = MsgTxt$ & chr(&h6709)&chr(&h5f62)&chr(&h30fb)&chr(&h7121)&chr(&h5f62) 778 MsgTxt$ = MsgTxt$ & chr(&h306e)&chr(&h4e21)&chr(&h65b9)&chr(&h3068)&chr(&h3082) 779 MsgTxt$ = MsgTxt$ & chr(&h5b8c)&chr(&h4e86)&chr(&h3057)&chr(&h3066)&chr(&h4e0b) 780 MsgTxt$ = MsgTxt$ & chr(&h3055)&chr(&h3044)&chr(&h3002) Rem 事業年度末の減価償却計算を有形 無形の両方とも完了して下さい Case Case 110 MsgTxt$ = chr(&h904e)&chr(&h5e74)&chr(&h5ea6)&chr(&h306e)&chr(&h6e1b) 784 MsgTxt$ = 過年度の減価償却データがありますので 償却方法の変更は & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h4fa1)&chr(&h511f)&chr(&h5374)&chr(&h30c7)&chr(&h30fc) 785 MsgTxt$ = MsgTxt$ & chr(&h30bf)&chr(&h304c)&chr(&h3042)&chr(&h308a)&chr(&h307e) 786 MsgTxt$ = MsgTxt$ & chr(&h3059)&chr(&h306e)&chr(&h3067)&chr(&h3001)&chr(&h511f) 787 MsgTxt$ = MsgTxt$ & chr(&h5374)&chr(&h65b9)&chr(&h6cd5)&chr(&h306e)&chr(&h5909) 788 MsgTxt$ = MsgTxt$ & chr(&h66f4)&chr(&h306f)&chr(&h4f1a)&chr(&h8a08)&chr(&h65b9) 789 MsgTxt$ = MsgTxt$ & chr(&h91dd)&chr(&h306e)&chr(13) Rem 過年度の減価償却データがありますので 償却方法の変更は会計方針の MsgTxt$ = MsgTxt$ & chr(&h5909)&chr(&h66f4)&chr(&h306b)&chr(&h8a72)&chr(&h5f53) 792 MsgTxt$ = MsgTxt$ & chr(&h3057)&chr(&h307e)&chr(&h3059)&chr(&h3002)&chr(&h305d) 793 MsgTxt$ = MsgTxt$ & chr(&h306e)&chr(&h305f)&chr(&h3081)&chr(&h306b)&chr(&h5fc5) 794 MsgTxt$ = MsgTxt$ & chr(&h8981)&chr(&h306a)&chr(&h627f)&chr(&h8a8d)&chr(&h7b49) 795 MsgTxt$ = MsgTxt$ & chr(&h306e)&chr(&h624b)&chr(&h7d9a)&chr(&h306f)&chr(&h3001) 796 MsgTxt$ = MsgTxt$ & chr(&h6e08)&chr(&h3093)&chr(&h3067)&chr(&h3044)&chr(&h307e) 797 MsgTxt$ = MsgTxt$ & chr(&h3059)&chr(&h304b)&chr(&hff1f) Rem 変更に該当します そのために必要な承認等の手続は 済んでいますか? MsgTxt$ = MsgTxt$ & 会計方針の変更に該当します そのために必要な承認等の & Chr(13) MsgTxt$ = MsgTxt$ & 手続は 済んでいますか? Case Case 111 MsgTxt$ = chr(&h904e)&chr(&h5e74)&chr(&h5ea6)&chr(&h306e)&chr(&h6e1b) 801 MsgTxt$ = 過年度の減価償却データがありますので 税務償却方法の & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h4fa1)&chr(&h511f)&chr(&h5374)&chr(&h30c7)&chr(&h30fc) 802 MsgTxt$ = MsgTxt$ & 変更に該当します そのために必要な届出等の手続は & Chr(13) MsgTxt$ = MsgTxt$ & chr(&h30bf)&chr(&h304c)&chr(&h3042)&chr(&h308a)&chr(&h307e) 803 MsgTxt$ = MsgTxt$ & 済んでいますか? ページ 12