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行:償却方法設定変更に応じた、ファイル新規保存、メッセージ)
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 会社名を登録してから再度実行して下さい。
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) = “定率法”
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
---(設立年月)---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 使用開始年は今年以前にして下さい。
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 新規ファイル名を、ダイアログ最下部Ⅶのボックスに入力して下さい。
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$ = “(税務)”
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 変更に該当します。そのために必要な届出等の手続は済んでいますか?
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 会計償却方法も指定するか、会計・税務とも「該当なし」にして下さい。
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を空欄にします。"
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 設定登録方法として、「従来からの使用継続の場合」が選択されています。
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$ & “済んでいますか?”
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 税務償却方法も指定するか、会計・税務とも「該当なし」にして下さい。