• 検索結果がありません。

Calculate メソッド

N/A
N/A
Protected

Academic year: 2021

シェア "Calculate メソッド"

Copied!
16
0
0

読み込み中.... (全文を見る)

全文

(1)

Rem ==================================================================== 1 Rem ====================================================================

Rem ダイアログの起動、設定変更プログラム 2 Rem ダイアログの起動、設定変更プログラム

Rem (Copyright:Shuichi Sunaga 2012) 3 Rem (Copyright:Shuichi Sunaga 2012)

Rem --- 4 Rem ---Rem 5 Rem Rem 6 Rem Rem 7 Rem Rem 8 Rem Rem 9 Rem Rem 10 Rem Rem --- 11 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 --- 37 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

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

RegisterDocListener()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

(Ver. 2007/03/31: 101行) (Ver. 2007/03/31: 101行)

(Ver. 2008/02/10:336行:設定変更時のチェック) (Ver. 2008/02/10:336行:設定変更時のチェック)

(Ver. 2008/12/12::576行:システム使用開始日を1日に限定/新資産領域確保は行表示へ) (Ver. 2008/12/12::576行:システム使用開始日を1日に限定/新資産領域確保は行表示へ)

(Ver. 2009/08/14::685行:XFDFolder指定)(Ver. 2009/10/20::754行:UniCode変換) (Ver. 2009/08/14::685行:XFDFolder指定)(Ver. 2009/10/20::754行:UniCode変換)

(Ver. 2009/12/02::882行:設定変更時のメッセージを集成) (Ver. 2009/12/02::882行:設定変更時のメッセージを集成)

(Ver. 2009/12/14:1029行:償却方法設定変更に応じた、ファイル新規保存、メッセージ) (Ver. 2009/12/14:1012行:償却方法設定変更に応じた、ファイル新規保存、メッセージ)

(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 = 225 77 BJHDlg.Height = 352

78 BJHDlg.FBX.Value = False 79

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 --- 99 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

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$ & chr(&H9332)&chr(&H304C)&chr(&H3042)&chr(&H308A)&chr(&H307E) 113 MsgTxt$ = MsgTxt$ & chr(&H305B)&chr(&H3093)&chr(&H3002)&chr(13) 114 115 MsgTxt$ = MsgTxt$ & chr(&H30B7)&chr(&H30B9)&chr(&H30C6)&chr(&H30E0)&chr(&H306E) 116 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 120 MsgTxt$ = MsgTxt$ & chr(&H4F1A)&chr(&H793E)&chr(&H540D)&chr(&H3092)&chr(&H767B) 121 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 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()

131

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 = 1 134 BJHDlg.OptInitialUse.Value = 1

Rem --- MouseListnerの設定 --- Rem --- Controlの設定

---MsgTtl$ = "Ooo3D減価償却&

MsgTxt$ =”会社名の登録がありません。” Rem 会社名の登録がありません。

MsgTxt$ = MsgTxt$ & “システムの設定(ALT→A→Z)画面からY” & Chr(13)

Rem システムの設定(Alt→A→Z)画面から

MsgTxt$ = MsgTxt$ & “会社名を登録してから再度実行して下さい。”

Rem 会社名を登録してから再度実行して下さい。

(3)

BJHDlg.GetControl("OptContinue").State = 0 135 BJHDlg.OptContinue.Value = 0

BJHDlg.GetControl("OptUserChange").State = 0 136 BJHDlg.OptUserChange.Value = 0

End Sub 137 End Sub

Sub sOptContinue() 138 Sub sOptContinue()

139

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 = 0 142 BJHDlg.OptInitialUse.Value = 0

BJHDlg.GetControl("OptContinue").State = 1 143 BJHDlg.OptContinue.Value = 1

BJHDlg.GetControl("OptUserChange").State = 0 144 BJHDlg.OptUserChange.Value = 0

End Sub 145 End Sub

Sub sOptUserChange() 146 Sub sOptUserChange()

147

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 = 0 150 BJHDlg.OptInitialUse.Value = 0

BJHDlg.GetControl("OptContinue").State = 0 151 BJHDlg.OptContinue.Value = 0

BJHDlg.GetControl("OptUserChange").State = 1 152 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 --- 156 Rem ---157

158

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)

161

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

170

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$) + 1 176 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 180 preList$(0) = chr(&H8A72)&chr(&H5F53)&chr(&H306A)&chr(&H3057) 該当なし 181 preList$(1) = chr(&H5B9A)&chr(&H984D)&chr(&H6CD5) 定額法 182 For i% = 0 to 7 183 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 Else 186 Else preList$(2) = chr(&H5B9A)&chr(&H7387)&chr(&H6CD5) 187 End If 188 End If IntDMTbl(i%) 189 IntDMTbl(i%) getDMTbl(i%) 190 getDMTbl(i%) Next i% 191 Next i% Rem --- 192 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

BJHDlg.Title = "[ OOo減価償却システム設定ダイアログ ] - 従来からの使用継続の場合" BJHDlg.Caption = "[ OOo減価償却システム設定ダイアログ ] - 従来からの使用継続の場合"

BJHDlg.Title = "[ OOo減価償却システム設定ダイアログ ] - 別会社での転用開始の場合" BJHDlg.Caption = "[ OOo減価償却システム設定ダイアログ ] - 別会社での転用開始の場合"

DcName$ = orgDir$() '付随的にsDirFile$(1)も取得される DcName$ = orgDir$ '付随的にsDirFile(1)も取得される

Rem ---(会社名)--- Rem ---(会社名)---Rem ---(設立年月)--- Rem ---(設立年月)---Rem ---(使用開始年月日)--- Rem ---(使用開始年月日)---Rem ---(償却方法)--- Rem ---(償却方法)---preList(0) = “該当なし” preList(1) = “定額法” 無形固定資産にかかる会計償却方法を'期間按分法で差替え preList(2) = "期間按分法" preList(2) = “定率法”

(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%

221

222 If BJHDlg.FBX.Value = False Then 223

224

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%) 241 242 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 object, oCB As object, oCls 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 --- 251 Rem ---MsgTtl$ = chr(&H5165)&chr(&H529B)&chr(&H6F0F)&chr(&H30C1)&chr(&H30A7) 252

MsgTtl$ = MsgTtl$ & chr(&H30C3)&chr(&H30AF) 253

254 255

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$ & chr(&H5165)&chr(&H529B)&chr(&H3067)&chr(&H3059)&chr(&H3002) 259 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

266

estYR$ = BJHDlg.GetControl("eYR").Text 267 estYR$ = BJHDlg.eYR.Value

If Len(estYR$) = 0 Then 268 If Len(estYR$) = 0 Then

Rem ---(会計償却方法)--- Rem ---(会計償却方法)---Rem ---(償却方法不一致チェックボックス)--- Rem ---(償却方法不一致チェックボックス)---MsgTtl$ =”入力漏チェック” Rem 入力漏チェック Rem ---(会社名)--- Rem ---(会社名)---MsgTxt$ = “会社名が未入力です。” Rem 会社名が未入力です。 Rem ---(設立年月)--- Rem

(5)

---(設立年月)---MsgTxt$ = chr(&H8A2D)&chr(&H7ACB)&chr(&H5E74)&chr(&H304C)&chr(&H672A) 269 MsgTxt$ = MsgTxt$ & chr(&H5165)&chr(&H529B)&chr(&H3067)&chr(&H3059)&chr(&H3002) 270 271

msgbox( MsgTxt$, 48, MsgTtl$) 272 msgbox MsgTxt$, vbExclamation, MsgTtl$

end 273 end

ElseIf Val(estYR$) < Year(Now()) - 100 Then 274 ElseIf Val(estYR$) < Year(Now()) - 100 Then

MsgTxt$ = chr(&H8A2D)&chr(&H7ACB)&chr(&H5E74)&chr(&H304C)&chr(&H0031) 275 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 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$ & chr(&H5E74)&chr(&H4EE5)&chr(&H524D)&chr(&H306B)&chr(&H3057) 287 MsgTxt$ = MsgTxt$ & chr(&H3066)&chr(&H4E0B)&chr(&H3055)&chr(&H3044)&chr(&H3002) 288 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$ & chr(&H5165)&chr(&H529B)&chr(&H3067)&chr(&H3059)&chr(&H3002) 296 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$ = 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 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$) 310

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$ & chr(&H304C)&chr(&H672A)&chr(&H5165)&chr(&H529B)&chr(&H3067) 314

MsgTxt$ = MsgTxt$ & chr(&H3059)&chr(&H3002) 315

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$ & 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 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$ & 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) 331

332

msgbox( MsgTxt$, 48, MsgTtl$) 333 msgbox MsgTxt$, vbExclamation, MsgTtl$

end 334 end MsgTxt$ = “設立年が未入力です。” Rem 設立年が未入力です。 MsgTxt$ = “設立年が100年以上前ですが正しいですか?” Rem 設立年が100年以上前ですが正しいですか? MsgTxt$ = “設立年は今年以前にして下さい。” Rem 設立年は今年以前にして下さい。 MsgTxt$ = “設立月が未入力です。” Rem 設立月が未入力です。 MsgTxt$ = “設立月が1から12までの範囲外です。” Rem 設立月が1から12までの範囲外です。 Rem ---(使用開始日)--- Rem ---(使用開始日)---MsgTxt$ = “使用開始年が未入力です。” Rem 使用開始年が未入力です。 MsgTxt$ = “使用開始年が設立年より前になっています。” Rem 使用開始年が設立年より前になっています。 MsgTxt$ = “使用開始年は今年以前にして下さい。” Rem 使用開始年は今年以前にして下さい。

(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$ & chr(&H304C)&chr(&H672A)&chr(&H5165)&chr(&H529B)&chr(&H3067) 339

MsgTxt$ = MsgTxt$ & chr(&H3059)&chr(&H3002) 340

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$ = 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 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$ & 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 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$) -1 364 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 --- 368 Rem ---MsgTtl$ = chr(&H511F)&chr(&H5374)&chr(&H65B9)&chr(&H6CD5)&chr(&H306E) 369 MsgTtl$ = MsgTtl$ & chr(&H6307)&chr(&H5B9A)&chr(&H78BA)&chr(&H8A8D) 370 371 setColArray("YUK") 372 setColArray("YUK") VeriConsAft() 373 VeriConsAft 374 375 376 Rem --- 377 Rem ---XFDFFolder() 378 XFDFFolder Rem --- 379 Rem ---RestoreHeaders() 380 RestoreHeaders ThisComponent.calculate 381 Application.Calculate

WkCL.Protect("pwd") 382 WkCL.Protect Password:="pwd"

383 384 385 386 387 388 GetMsgTxt$(400) 389 GetMsgTxt$(400) 390 391

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+6 395

BJHDlg.Model.Height = BJHDlg.Model.Height+65 396 BJHDlg.Height = BJH.Height + 38

BJHDlg.GetControl("DocNMBox").setFocus() 397

BJHDlg.Visible=True 398

GetMsgTxt$(410) 399 GetMsgTxt$(410)

400

MsgBox(MsgTxt$, 0, MsgTtl$) 401 MsgBox MsgTxt$, vbOKOnly, MsgTtl$

MsgTxt$ = “使用開始月が未入力です。” Rem 使用開始月が未入力です。 MsgTxt$ = “使用開始月が1から12までの範囲外です。” Rem 使用開始月が1から12までの範囲外です。 MsgTxt$ = “使用開始年月が設立年月より前になっています。” Rem 使用開始年月が設立年月より前になっています。 MsgTtl$ = “償却方法の指定確認” Rem ---償却方法の指定確認(有形固定資産)--- Rem ---償却方法の指定確認(有形固定資産)---Rem 償却方法につき、次の変更が設定されました。 Rem 償却方法につき、次の変更が設定されました。 Rem 変更後ファイルを新規ファイル名で保存しますか? Rem 変更後ファイルを新規ファイル名で保存しますか? Rem 新規ファイル名を、ダイアログ最下部Ⅶのボックスに入力して下さい。 Rem 新規ファイル名を、ダイアログ最下部Ⅶのボックスに入力して下さい。

(7)

402 BJHDlg.DocNMBox.SetFocus

Exit Sub 403 Exit Sub

Else 404 Else OnOut 405 OnOut 406 407 408 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 GetMsgTxt$(421) 419 GetMsgTxt$(421) msgbox(MsgTxt$, 0, MsgTtl$) 420 msgbox MsgTxt$, 0, MsgTtl$ Else 421 Else 422 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%-1 429 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"

433

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%-1 439 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 --- 443 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.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

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 sTWD$ = chr(&H0028)&chr(&H7A0E)&chr(&H52D9)&chr(&H0029)&chr(&HFF1A) 459

sparrow$ = Chr(&H0020)&Chr(&H2794)&Chr(&H0020) 460 Sparrow$ = " "⇒

WhatClsChg$ = "" 461 WhatClsChg$ = ""

For i% = 0 To 7 462 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)

BJHDlg.StoreURL.Caption = “ 保存” Rem ---償却累計額保存列の削除(有形固定資産)--- Rem ---償却累計額保存列の削除(有形固定資産)---Rem ---償却累計額保存列の削除(無形固定資産)--- Rem ---償却累計額保存列の削除(無形固定資産)---BJHDlg.StoreURL.Caption = “保存完了” BJHDlg.StoreURL.Caption = “保存開始” (会計): sBWD$ = “(会計): (税務): sTWD$ = “(税務)”

(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 6 487 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

Rem --- 508 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"

512

If BDM(h%).Text = sWD$ Or TDM(h%).Text = sWD$ Then 513 If BDM(h%).Value = sWD$ Or TDM(h%).Value = sWD$ Then

GetMsgTxt$(100) 514 GetMsgTxt$(100)

515

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

520

If BDM(h%).Text <> BCH(h%).Text Then 521 If BDM(h%).Value <> BCH(h%).Value Then

GetMsgTxt$(110) 522 GetMsgTxt$(110)

523 524

ElseIf TDM(h%).Text <> TCH(h%).Text Then 525 ElseIf TDM(h%).Value <> TCH(h%).Value Then

GetMsgTxt$(111) 526 GetMsgTxt$(111)

527 528

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 sWD$ = “該当なし” Rem MsgTtl$ = 償却方法変更チェック Rem MsgTtl$ = 償却方法変更チェック 会計or税務:該当なし Rem 過年度の減価償却データがありますので、該当なしへの変更はできません。 Rem 過年度の減価償却データがありますので、該当なしへの変更はできません。 Rem ---(償却計算後、WkCLのセルB22は更新されるため、これが期末であることを確認) Rem ---(償却計算後、WkCLのセルB22は更新されるため、これが期末であることを確認) Rem 過年度の減価償却データがありますので、償却方法の変更は会計方針の Rem 過年度の減価償却データがありますので、償却方法の変更は会計方針の Rem 変更に該当します。そのために必要な承認等の手続は済んでいますか? Rem 変更に該当します。そのために必要な承認等の手続は済んでいますか? Rem 過年度の減価償却データがありますので、償却方法の変更は税務償却方法の Rem 過年度の減価償却データがありますので、償却方法の変更は税務償却方法の Rem 変更に該当します。そのために必要な届出等の手続は済んでいますか? Rem 変更に該当します。そのために必要な届出等の手続は済んでいますか?

(9)

GetMsgTxt$(105) 536 GetMsgTxt$(105) 537 538 539 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$

556

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$

564

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)

584 585 586

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%), 1 590 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$

596

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

Rem 減価償却方法の変更は事業年度末での計算が完了している場合に Rem 減価償却方法の変更は事業年度末での計算が完了している場合に Rem だけ行なうことができます。変更後償却方法の適用年度の直前の Rem だけ行なうことができます。変更後償却方法の適用年度の直前の Rem 事業年度末の減価償却計算を有形・無形の両方とも完了して下さい。 Rem 事業年度末の減価償却計算を有形・無形の両方とも完了して下さい。 Rem 会計償却方法も指定するか、会計・税務とも「該当なし」にして下さい。 Rem 会計償却方法も指定するか、会計・税務とも「該当なし」にして下さい。 Rem 税務償却方法も指定するか、会計・税務とも「該当なし」にして下さい。 Rem 税務償却方法も指定するか、会計・税務とも「該当なし」にして下さい。 (新規開始の場合)or(転用の場合) Rem 償却方法変更チェック Rem 償却方法変更チェック Rem 過年度取得の償却資産データが入力されています。 Rem 過年度取得の償却資産データが入力されています。 Rem 一行だけ残して、これらの他の行を削除しますか? Rem 一行だけ残して、これらの他の行を削除しますか? Rem 会計償却方法も指定するか、会計・税務とも「該当なし」にして下さい。 Rem 会計償却方法も指定するか、会計・税務とも「該当なし」にして下さい。

(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$

618

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$

626

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)

644 645 646 647

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)

660

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 7 668 For i% = 0 To 7

BkDMtd$(i%) =CellString(WkCL, 11+i%, 3) 669 BkDMtd(i%) =CellString(WkCL, 11+i%, 3)

Rem 会計償却方法も指定するか、会計・税務とも「該当なし」にして下さい。 Rem 会計償却方法も指定するか、会計・税務とも「該当なし」にして下さい。

Rem 税務償却方法も指定するか、会計・税務とも「該当なし」にして下さい。 Rem 税務償却方法も指定するか、会計・税務とも「該当なし」にして下さい。

Rem MsgTtl$ = "不一致欄の処理" Rem MsgTtl$ = "不一致欄の処理"

Rem "会計・税務で同じ償却方法が選択されました。" & CHr(13) Rem "会計・税務で同じ償却方法が選択されました。" & CHr(13)

Rem "この場合、耐用年数、残存価額等すべて一致" & Chr(13) Rem "この場合、耐用年数、残存価額等すべて一致" & Chr(13)

Rem "するときだけ、不一致Boxを空欄にします。" Rem "するときだけ、不一致Boxを空欄にします。"

(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$ & chr(&H66F4)&chr(&H30C1)&chr(&H30A7)&chr(&H30C3)&chr(&H30AF) 680 681

Select Case msgNum% 682 Select Case msgNum%

Case 10 683 Case 10

MsgTtl$ = chr(&H8A2D)&chr(&H5B9A)&chr(&H767B)&chr(&H9332)&chr(&H65B9) 684 MsgTtl$ = MsgTtl$ & chr(&H6CD5)&chr(&H306E)&chr(&H78BA)&chr(&H8A8D) 685 686 MsgTxt$ = Chr(&H00A0)&chr(&H2165)&chr(&H306E)&chr(&H8A2D)&chr(&H5B9A) 687 MsgTxt$ = MsgTxt$ & chr(&H767B)&chr(&H9332)&chr(&H65B9)& chr(&H6CD5)&chr(&H3068) 688 MsgTxt$ = MsgTxt$ & chr(&H3057)&chr(&H3066)&chr(&H3001)&Chr(13) 689 690 MsgTxt$ = MsgTxt$ & chr(&H300C)&chr(&H65B0)&chr(&H898F)&chr(&H5C0E)&chr(&H5165) 691 MsgTxt$ = MsgTxt$ & chr(&H30FB)&chr(&H8EE2)&chr(&H7528)&chr(&H958B)&chr(&H59CB) 692 MsgTxt$ = MsgTxt$ & chr(&H306E)&chr(&H5834)&chr(&H5408)&chr(&H300D) 693 694 MsgTxt$ = MsgTxt$ & chr(&H304C)&chr(&H9078)&chr(&H629E)&chr(&H3055)&chr(&H308C) 695 MsgTxt$ = MsgTxt$ & chr(&H307E)&chr(&H3057)&chr(&H305F)&chr(&H3002)&Chr(13)&Chr(13) 696 697 MsgTxt$ = MsgTxt$ & chr(&H3053)&chr(&H306E)&chr(&H30AA)&chr(&H30D7)&chr(&H30B7) 698 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 702 MsgTxt$ = MsgTxt$ & chr(&H8EE2)&chr(&H7528)&chr(&H958B)&chr(&H59CB)&chr(&H306E) 703 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 709 MsgTxt$ = MsgTxt$ & chr(&H4ED6)&chr(&H65B9)&chr(&H3001)&chr(&H65B0)&chr(&H898F) 710 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 716 MsgTxt$ = MsgTxt$ & chr(&H65B0)&chr(&H898F)&chr(&H30D5)&chr(&H30A1)&chr(&H30A4) 717 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 722 MsgTxt$ = MsgTxt$ & chr(&H4E0A)&chr(&H66F8)&chr(&H304D)&chr(&H4FDD)&chr(&H5B58) 723 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 727 Case 100 728 Case 100 MsgTxt$ = chr(&H8A2D)&chr(&H5B9A)&chr(&H767B)&chr(&H9332)&chr(&H65B9) 729 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) 735 736 MsgTtl$ = “償却方法変更チェック” Rem 償却方法変更チェック MsgTtl$ = “設定登録方法の確認” Rem 設定登録方法の確認 MsgTxt$ = “Ⅵの設定登録方法として、” & Chr(13) Rem Ⅵの設定登録方法として、 MsgTxt$ = MsgTxt$ & “「新規導入・転用開始の場合」” Rem 「新規導入・転用開始の場合」 MsgTxt$ = MsgTxt$ & “が選択されました。” & Chr(13) Rem が選択されました。 MsgTxt$ = MsgTxt$ & “このオプションでの設定完了時の操作は、” & Chr(13) Rem このオプションでの設定完了時の操作は、 MsgTxt$ = MsgTxt$ & “転用開始の場合は、必ず、新規ファイル名で保存します。” & Chr(13) Rem 転用開始の場合は、必ず、新規ファイル名で保存します。 MsgTxt$ = MsgTxt$ & “他方、新規導入の場合は、どちらもOKです。すなわち、” & Chr(13) Rem 他方、新規導入の場合は、どちらもOKです。すなわち、 MsgTxt$ = MsgTxt$ & “新規ファイル名での保存、ファイル名を変更しない” & Chr(13) Rem 新規ファイル名での保存、ファイル名を変更しない MsgTxt$ = MsgTxt$ & “上書き保存のどちらでもOKです。” Rem 上書き保存のどちらでもOKです。 MsgTxt$ = “設定登録方法として、「従来からの使用継続の場合」が選択されています。” & Chr(13) Rem 設定登録方法として、「従来からの使用継続の場合」が選択されています。

(12)

MsgTxt$ = MsgTxt$ & chr(&H3053)&chr(&H306E)&chr(&H30E2)&chr(&H30FC)&chr(&H30C9) 737 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) 743 744 MsgTxt$ = MsgTxt$ & chr(&H3078)&chr(&H306E)&chr(&H5909)&chr(&H66F4)&chr(&H306F) 745 MsgTxt$ = MsgTxt$ & chr(&H3067)&chr(&H304D)&chr(&H307E)&chr(&H305B)&chr(&H3093) 746 MsgTxt$ = MsgTxt$ & chr(&H3002)&Chr(13)&Chr(13) 747 748 MsgTxt$ = MsgTxt$ & chr(&H8A2D)&chr(&H5B9A)&chr(&H767B)&chr(&H9332)&chr(&H65B9) 749 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) 755 756 MsgTxt$ = MsgTxt$ & chr(&H9069)&chr(&H5207)&chr(&H306A)&chr(&H65B9)&chr(&H6CD5) 757 MsgTxt$ = MsgTxt$ & chr(&H306B)&chr(&H5909)&chr(&H66F4)&chr(&H3057)&chr(&H307E) 758 MsgTxt$ = MsgTxt$ & chr(&H3059)&chr(&H3002) 759 760 Case 105 761 Case 105 MsgTxt$ = chr(&H6E1B)&chr(&H4FA1)&chr(&H511F)&chr(&H5374)&chr(&H65B9) 762 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) 767 768 MsgTxt$ = MsgTxt$ & chr(&H3060)&chr(&H3051)&chr(&H884C)&chr(&H306A)&chr(&H3046) 769 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) 774 775 MsgTxt$ = MsgTxt$ & chr(&H5E74)&chr(&H5EA6)&chr(&H672B)&chr(&H306E) 776 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) 781 782 Case 110 783 Case 110 MsgTxt$ = chr(&H904E)&chr(&H5E74)&chr(&H5EA6)&chr(&H306E)&chr(&H6E1B) 784 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) 790 791 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) 798 799 Case 111 800 Case 111 MsgTxt$ = chr(&H904E)&chr(&H5E74)&chr(&H5EA6)&chr(&H306E)&chr(&H6E1B) 801 MsgTxt$ = MsgTxt$ & chr(&H4FA1)&chr(&H511F)&chr(&H5374)&chr(&H30C7)&chr(&H30FC) 802 MsgTxt$ = MsgTxt$ & chr(&H30BF)&chr(&H304C)&chr(&H3042)&chr(&H308A)&chr(&H307E) 803 MsgTxt$ = MsgTxt$ & “このモードでは、過年度の減価償却データがありますので、「該当なし」” & Chr(13) Rem このモードでは、過年度の減価償却データがありますので、「該当なし」

MsgTxt$ = MsgTxt$ & “ への変更はできません。” & Chr(13) & Chr(13) Rem への変更はできません。 MsgTxt$ = MsgTxt$ & “設定登録方法が適切でない場合は、ダイアログ下部のセクションⅥで” & Chr(13) Rem 設定登録方法が適切でない場合は、ダイアログ下部のセクションⅥで MsgTxt$ = MsgTxt$ & “適切な方法に変更します。” Rem 適切な方法に変更します。 MsgTxt$ = “減価償却方法の変更は事業年度末での計算が完了している場合に” & Chr(13) Rem 減価償却方法の変更は事業年度末での計算が完了している場合に MsgTxt$ = MsgTxt$ & “だけ行なうことができます。変更後償却方法の適用年度の直前の” & Chr(13) Rem だけ行なうことができます。変更後償却方法の適用年度の直前の MsgTxt$ = MsgTxt$ & “事業年度末の減価償却計算を有形・無形の両方とも完了して下さい。” Rem 事業年度末の減価償却計算を有形・無形の両方とも完了して下さい。 MsgTxt$ = “過年度の減価償却データがありますので、償却方法の変更は” & Chr(13) Rem 過年度の減価償却データがありますので、償却方法の変更は会計方針の MsgTxt$ = MsgTxt$ & “会計方針の変更に該当します。そのために必要な承認等の” & Chr(13) MsgTxt$ = MsgTxt$ & “手続は、済んでいますか?” Rem 変更に該当します。そのために必要な承認等の手続は、済んでいますか? MsgTxt$ = “過年度の減価償却データがありますので、税務償却方法の” & Chr(13) MsgTxt$ = MsgTxt$ & “変更に該当します。そのために必要な届出等の手続は、” & Chr(13) MsgTxt$ = MsgTxt$ & “済んでいますか?”

(13)

MsgTxt$ = MsgTxt$ & chr(&H3059)&chr(&H306E)&chr(&H3067)&chr(&H3001)&chr(&H511F) 804 MsgTxt$ = MsgTxt$ & chr(&H5374)&chr(&H65B9)&chr(&H6CD5)&chr(&H306E)&chr(&H5909) 805 MsgTxt$ = MsgTxt$ & chr(&H66F4)&chr(&H306F)&chr(&H7A0E)&chr(&H52D9)&chr(&H511F) 806 MsgTxt$ = MsgTxt$ & chr(&H5374)&chr(&H65B9)&chr(&H6CD5)&chr(&H306E)&Chr(13) 807 808 MsgTxt$ = MsgTxt$ & chr(&H5909)&chr(&H66F4)&chr(&H306B)&chr(&H8A72)&chr(&H5F53) 809 MsgTxt$ = MsgTxt$ & chr(&H3057)&chr(&H307E)&chr(&H3059)&chr(&H3002)&chr(&H305D) 810 MsgTxt$ = MsgTxt$ & chr(&H306E)&chr(&H305F)&chr(&H3081)&chr(&H306B)&chr(&H5FC5) 811 MsgTxt$ = MsgTxt$ & chr(&H8981)&chr(&H306A)&chr(&H5C4A)&chr(&H51FA)&chr(&H7B49) 812 MsgTxt$ = MsgTxt$ & chr(&H306E)&chr(&H624B)&chr(&H7D9A)&chr(&H306F)&chr(&H3001) 813 MsgTxt$ = MsgTxt$ & chr(&H6E08)&chr(&H3093)&chr(&H3067)&chr(&H3044)&chr(&H307E) 814 MsgTxt$ = MsgTxt$ & chr(&H3059)&chr(&H304B)&chr(&HFF1F) 815 816 Case 200 817 Case 200 MsgTxt$ = chr(&H904E)&chr(&H5E74)&chr(&H5EA6)&chr(&H53D6)&chr(&H5F97) 818 MsgTxt$ = MsgTxt$ & chr(&H306E)&chr(&H511F)&chr(&H5374)&chr(&H8CC7)&chr(&H7523) 819 MsgTxt$ = MsgTxt$ & chr(&H30C7)&chr(&H30FC)&chr(&H30BF)&chr(&H304C)&chr(&H5165) 820 MsgTxt$ = MsgTxt$ & chr(&H529B)&chr(&H3055)&chr(&H308C)&chr(&H3066)&chr(&H3044) 821 MsgTxt$ = MsgTxt$ & chr(&H307E)&chr(&H3059)&chr(&H3002)&chr(13) 822 823 MsgTxt$ = MsgTxt$ & chr(&H4E00)&chr(&H884C)&chr(&H3060)&chr(&H3051)&chr(&H6B8B) 824 MsgTxt$ = MsgTxt$ & chr(&H3057)&chr(&H3066)&chr(&H3001)&chr(&H3053)&chr(&H308C) 825 MsgTxt$ = MsgTxt$ & chr(&H3089)&chr(&H306E)&chr(&H4ED6)&chr(&H306E)&chr(&H884C) 826 MsgTxt$ = MsgTxt$ & chr(&H3092)&chr(&H524A)&chr(&H9664)&chr(&H3057)&chr(&H307E) 827 MsgTxt$ = MsgTxt$ & chr(&H3059)&chr(&H304B)&chr(&HFF1F) 828 829 Case 210 830 Case 210 MsgTtl$ = chr(&H4E0D)&chr(&H4E00)&chr(&H81F4)&chr(&H6B04)&chr(&H306E) 831 MsgTtl$ = MsgTtl$ & chr(&H51E6)&chr(&H7406) 832 833 MsgTxt$ = chr(&H4F1A)&chr(&H8A08)&chr(&H30FB)&chr(&H7A0E)&chr(&H52D9) 834 MsgTxt$ = MsgTxt$ & chr(&H3067)&chr(&H540C)&chr(&H3058)&chr(&H511F)&chr(&H5374) 835 MsgTxt$ = MsgTxt$ & chr(&H65B9)&chr(&H6CD5)&chr(&H304C)&chr(&H9078)&chr(&H629E) 836 MsgTxt$ = MsgTxt$ & chr(&H3055)&chr(&H308C)&chr(&H307E)&chr(&H3057)&chr(&H305F) 837 MsgTxt$ = MsgTxt$ & chr(&H3002)&Chr(13) 838 839 MsgTxt$ = MsgTxt$ &chr(&H3053)&chr(&H306E)&chr(&H5834)&chr(&H5408)&chr(&H3001) 840 MsgTxt$ = MsgTxt$ & chr(&H8010)&chr(&H7528)&chr(&H5E74)&chr(&H6570)&chr(&H3001) 841 MsgTxt$ = MsgTxt$ & chr(&H6B8B)&chr(&H5B58)&chr(&H4FA1)&chr(&H984D)&chr(&H7B49) 842 MsgTxt$ = MsgTxt$ & chr(&H3059)&chr(&H3079)&chr(&H3066)&chr(&H4E00)&chr(&H81F4)&Chr(13) 843 844 MsgTxt$ = MsgTxt$ & chr(&H3059)&chr(&H308B)&chr(&H3068)&chr(&H304D)&chr(&H3060) 845 MsgTxt$ = MsgTxt$ & chr(&H3051)&chr(&H3001)&chr(&H4E0D)&chr(&H4E00)&chr(&H81F4) 846 MsgTxt$ = MsgTxt$ & chr(&H0042)&chr(&H004F)&chr(&H0058)&chr(&H3092)&chr(&H7A7A) 847 MsgTxt$ = MsgTxt$ & chr(&H6B04)&chr(&H306B)&chr(&H3057)&chr(&H307E)&chr(&H3059) 848 MsgTxt$ = MsgTxt$ & chr(&H3002)&Chr(13) 849 850 MsgTxt$ = MsgTxt$ & chr(&H4E0D)&chr(&H4E00)&chr(&H81F4)&chr(&H30DC)&chr(&H30C3) 851 MsgTxt$ = MsgTxt$ & chr(&H30AF)&chr(&H30B9)&chr(&H3092)&chr(&H7A7A)&chr(&H6B04) 852 MsgTxt$ = MsgTxt$ & chr(&H306B)&chr(&H3057)&chr(&H307E)&chr(&H3059)&chr(&H304B) 853 MsgTxt$ = MsgTxt$ & chr(&HFF1F) 854 855 Case 300 856 Case 300 MsgTxt$ = chr(&H30C0)&chr(&H30A4)&chr(&H30A2)&chr(&H30ED)&chr(&H30B0) 857 MsgTxt$ = MsgTxt$ & chr(&H4E2D)&chr(&H3001)&chr(&H30D4)&chr(&H30F3)&chr(&H30AF) 858 MsgTxt$ = MsgTxt$ & chr(&H80CC)&chr(&H666F)&chr(&H8272)&chr(&H306E)&chr(&H8CC7) 859 MsgTxt$ = MsgTxt$ & chr(&H7523)&chr(&H7A2E)&chr(&H985E)&chr(&H306B)&chr(&H3064) 860 MsgTxt$ = MsgTxt$ & chr(&H3044)&chr(&H3066)&chr(13) 861 MsgTxt$ = MsgTxt$ & chr(&H4F1A)&chr(&H8A08)&chr(&H511F)&chr(&H5374)&chr(&H65B9) 862 MsgTxt$ = MsgTxt$ & chr(&H6CD5)&chr(&H3082)&chr(&H6307)&chr(&H5B9A)&chr(&H3059) 863 MsgTxt$ = MsgTxt$ & chr(&H308B)&chr(&H304B)&chr(&H3001)&Chr(13) 864 MsgTxt$ = MsgTxt$ & chr(&H4F1A)&chr(&H8A08) 865 MsgTxt$ = MsgTxt$ & chr(&H30FB)&chr(&H7A0E)&chr(&H52D9)&chr(&H3068)&chr(&H3082) 866 MsgTxt$ = MsgTxt$ & chr(&H300C)&chr(&H8A72)&chr(&H5F53)&chr(&H306A)&chr(&H3057) 867 MsgTxt$ = MsgTxt$ & chr(&H300D)&chr(&H306B)&chr(&H3057)&chr(&H3066)&chr(&H4E0B) 868 MsgTxt$ = MsgTxt$ & chr(&H3055)&chr(&H3044)&chr(&H3002) 869 870 Rem 過年度の減価償却データがありますので、償却方法の変更は税務償却方針の Rem 変更に該当します。そのために必要な承認等の手続は、済んでいますか? MsgTxt$ = “過年度取得の償却資産データが入力されています。” & Chr(13) Rem 過年度取得の償却資産データが入力されています。 MsgTxt$ = MsgTxt$ & “一行だけ残して、これらの他の行を削除しますか?” Rem 一行だけ残して、これらの他の行を削除しますか? MsgTtl$ = "不一致欄の処理" Rem MsgTtl$ = "不一致欄の処理" MsgTxt$ = "会計・税務で同じ償却方法が選択されました。" & CHr(13) Rem MsgTxt$ = "会計・税務で同じ償却方法が選択されました。" & CHr(13) MsgTxt$ = MsgTxt$ & "この場合、耐用年数、残存価額等すべて一致" & Chr(13)

Rem MsgTxt$ = MsgTxt$ & "この場合、耐用年数、残存価額等すべて一致" & Chr(13)

MsgTxt$ = MsgTxt$ & "するときだけ、不一致Boxを空欄にします。" & Chr(13)

Rem MsgTxt$ = MsgTxt$ & "するときだけ、不一致Boxを空欄にします。"

MsgTxt$ = MsgTxt$ & “不一致ボックスを空欄にしますか?” Rem 不一致ボックスを空欄にしますか? MsgTxt$ = “ダイアログ中、ピンク背景色の資産種類について” & Chr(13) MsgTxt$ = MsgTxt$ & “会計償却方法も指定するか、“ & Chr(13) MsgTxt$ = MsgTxt$ & “会計・税務とも「該当なし」にして下さい。” Rem 税務償却方法も指定するか、会計・税務とも「該当なし」にして下さい。

参照

関連したドキュメント

As we have anticipated, Theo- rem 4.1 of [11] ensures that each immersed minimal surface having properly embedded ends with finite total curvature that is in a neighbourhood of M k

Applying the representation theory of the supergroupGL(m | n) and the supergroup analogue of Schur-Weyl Duality it becomes straightforward to calculate the combinatorial effect

In particular we prove an existence theo- rem for tempered solutions of ordinary differential equations in the subanalytic topology, thus refining the classical results on small

The key lemma required is a combinatorial version of Dehn’s lemma and the loop theorem for immersed surfaces of the type considered by Hass and Scott with an extra condition —

This property is a measure-theoretic analogue of the ergodic “mixing property.” Theorem 3.8 gives a graph-theoretic analogue of the Wallace theo- rem in which the horocycle flow on

This property is a measure-theoretic analogue of the ergodic “mixing property.” Theorem 3.8 gives a graph-theoretic analogue of the Wallace theo- rem in which the horocycle flow on

This property is a measure-theoretic analogue of the ergodic “mixing property.” Theorem 3.8 gives a graph-theoretic analogue of the Wallace theo- rem in which the horocycle flow on

In a preliminary section, we establish an analogue of the Minkowski–Weyl theo- rem (Theorem 2), showing that a tropical polyhedron can be equivalently described either as the sum of