Option Explicit Type keisan
saveName As String '保存名 payW As String '時給1・月給２ choiceAge As String '年齢区分 workT As Integer '時間 payH As Long '時給（交通費なし） payM As Long '月給（交通費なし）：時給の場合はpayH×workT transport As Integer '交通費 remuneration As Long '月額報酬 月給の場合はそのまま、時給の場合は時給×単価＋交通費 health As Long '健康保険 welfare As Long '厚生年金 care As Long '介護保険 job As Long '雇用保険
End Type
Sub 社会保険料算出_Click()
'時給か月収が選択されていない場合
Dim choiceHM As String
choiceHM = Cells(7, 4).Value
If choiceHM = "" Then
MsgBox "時給もしくは月給を選択してください。"
Exit Sub
End If
Dim choiceAge As String
choiceAge = Cells(7, 6).Value
If choiceAge = "" Then
MsgBox "年齢を選択してください。"
Exit Sub
End If
Dim hour As Integer Dim transport As Long Dim splInput As Long Dim payInput As Long
'入力値が数値じゃない場合メッセージを表示する。
If Not IsNumeric(Cells(5, 8)) Or Not IsNumeric(Cells(5, 12)) Or Not IsNumeric(Cells(5, 16)) Or Not IsNumeric(Cells(7, 16)) Then
MsgBox "数字を入力してください。"
Exit Sub
End If
'入力値＝変数
If Cells(7, 6) = 1 Then
choiceAge = "３９歳以下"
Else
choiceAge = "４０歳以上"
End If
transport = Cells(7, 16).Value
splInput = Cells(5, 12).Value
payInput = Cells(5, 16).Value
'勤務時間 入力がなければ１６０時間とする
If Cells(5, 8) = 0 Then
hour = 160
Else
hour = Cells(5, 8)
End If
'年齢、支給額、入金額が未入力の場合メッセージを出す
If splInput = 0 Or payInput = 0 Then
If choiceHM = "1" Then
hour = 0
End If
MsgBox "入力してください。"
Exit Sub
End If
ActiveSheet.Unprotect
'保険料シートのため Dim i As Integer Dim j As Integer Dim payH As Long '時給（交通費なし） Dim payM As Long '月給（交通費なし） Dim splH As Long '月の入金額 Dim splM As Long '時間の入金額 Dim remuneration As Long '月額報酬 Dim health As Long '健康保険 Dim welfare As Long '厚生年金 Dim care As Long '介護保険 Dim job As Long '雇用保険 Dim total As Long '保険合計＝健康保険＋厚生年金＋介護保険＋雇用保険 Dim cost As Long '経費合計（交通費有）＝保険合計＋月額報酬 Dim costNoTransport As Long '経費合計（交通費無）＝保険合計＋月給 Dim del As Long '差額（交通費有）＝入金額ー経費合計（交通費有） Dim delNoTransport As Long '差額（交通費無）＝入金額ー経費合計（交通費無）
'menuにメニュー、datasheetに保険料
Dim menu As Worksheet
Set menu = ThisWorkbook.Worksheets("メニュー")
Dim datasheet As Worksheet
Set datasheet = ThisWorkbook.Worksheets("保険料")
'保存用
Range("F19").Value = choiceAge
Range("G19").Value = hour
Range("H19").Value = transport
'時給の時
If choiceHM = 1 Then
splH = splInput
splM = splH * hour
Range("I19").Value = splM
'支給金額を計算
For i = -2 To 2
'時給が－100円、－50円、0円、50円、＋100円のパターンを表示
payH = payInput + i * 50
Cells(14 + i, 10).Value = payH
'報酬月給（時給×月の勤務時間＋交通費）
payM = Cells(14 + i, 10).Value * hour
remuneration = payM + transport
Cells(14 + i, 11).Value = remuneration
'保険料シートを上から回す
For j = 6 To 55
'「保険料」の報酬月額（以上）＜月給＜「保険料」の報酬月額（未満）
If datasheet.Cells(j, 3).Value <= remuneration And remuneration < datasheet.Cells(j, 4) Then
'健康保険
health = datasheet.Cells(j, 6).Value
Cells(14 + i, 12) = health
'厚生年金
welfare = datasheet.Cells(j, 9).Value
Cells(14 + i, 13) = welfare
'介護保険
If choiceAge = "３９歳以下" Then
care = 0
Else
care = datasheet.Cells(j, 7).Value
End If
Cells(14 + i, 14).Value = care
'雇用保険
job = Round((Cells(14 + i, 11).Value / 160), 0)
Cells(14 + i, 15).Value = job
'保険合計
total = health + welfare + care + job
Cells(14 + i, 16).Value = total
'経費合計（交通費有）＝保険合計＋月額報酬
cost = total + remuneration
Cells(14 + i, 17).Value = cost
'経費合計（交通費無）＝保険合計＋月給
costNoTransport = total + payM
Cells(14 + i, 18).Value = costNoTransport
'差額（交通費有）＝時給＊１６０－経費合計（交通費有）
del = splM - cost
Cells(14 + i, 19).Value = del
'差額（交通費なし）＝時給＊１６０－経費合計（交通費無）
delNoTransport = splM - costNoTransport
Cells(14 + i, 20).Value = delNoTransport
Exit For
End If
Next
Next
'月給の時
Else
splM = splInput
splH = Round((splM / hour), 0)
Range("I19").Value = splM
For i = -2 To 2
'報酬月額が－10000円、－5000円、0円、＋5000円、＋10000円のパターンを表示
payM = payInput + i * 5000
remuneration = payM + transport
Cells(14 + i, 11).Value = remuneration
'時給（１６０時間として計算）交通費無
payH = Round(((payM + i * 5000) / hour), 0)
Cells(14 + i, 10).Value = payH
'保険料シートを上から回す
For j = 6 To 55
'「保険料」の報酬月額（以上）＜＝月給＜「保険料」の月額報酬（未満）
If datasheet.Cells(j, 3).Value <= remuneration And remuneration < datasheet.Cells(j, 4) Then
'健康保険
health = datasheet.Cells(j, 6).Value
Cells(14 + i, 12) = health
'厚生年金
welfare = datasheet.Cells(j, 9).Value
Cells(14 + i, 13) = welfare
'介護保険
If choiceAge = "３９歳以下" Then
care = 0
Else
care = datasheet.Cells(j, 7).Value
End If
Cells(14 + i, 14).Value = care
'雇用保険（報酬月額＊0.006）
job = Round((Cells(14 + i, 11).Value / 160), 0)
Cells(14 + i, 15).Value = job
'保険合計
total = health + welfare + care + job
Cells(14 + i, 16).Value = total
'経費合計（交通費有）＝保険合計＋月額報酬
cost = total + remuneration
Cells(14 + i, 17).Value = cost
'経費合計（交通費無）＝保険合計＋月給
costNoTransport = total + payM
Cells(14 + i, 18).Value = costNoTransport
'差額（交通費有）＝時給＊１６０－経費合計（交通費有）
del = splM - cost
Cells(14 + i, 19).Value = del
'差額（交通費無）＝時給＊１６０－経費合計（交通費無）
delNoTransport = splM - costNoTransport
Cells(14 + i, 20).Value = delNoTransport
Exit For
End If
Next
Next
End If
ActiveSheet.Protect
End Sub
Sub 時給_Click() ' written by Kinami 2011/11
ActiveSheet.Unprotect
Cells(5, 11).Value = "時給" Cells(5, 15).Value = "時給" Cells(5, 12).Value = 0
'時給ははじめ１６０時間で設定
Range("H5").Value = 160
Range("K6:Q6").Font.ColorIndex = 1
ActiveSheet.Protect
End Sub
Sub 月給_Click() ' written by Kinami 2011/11
ActiveSheet.Unprotect
Cells(5, 11).Value = "月給"
Cells(5, 15).Value = "月給"
Cells(5, 12).Value = 0
Range("H5").Value = 160
Range("K6:Q6").Font.ColorIndex = 2
ActiveSheet.Protect
End Sub
Sub クリア_Click() ' written by Kinami 2011/11
ActiveSheet.Unprotect
Range("F5").ClearContents '年齢
Range("H5").ClearContents '勤務時間
Range("L5").ClearContents '入金額
Range("P7").ClearContents '交通費
Range("F11").ClearContents '保存名
'計算結果をクリア
Range("j12:T16").ClearContents
'画面遷移時は時給計算の設定にしておく
Range("D7").Value = 1
Call 時給_Click
ActiveSheet.Protect
Range("L5").Select
End Sub
Sub save2db() '================このコードは 支給計算シートで実行される ' written by Kasahara 2011/11/16
Application.ScreenUpdating = False '画面描画の停止
'算出履歴
Dim resultSheet As Worksheet
Set resultSheet = ThisWorkbook.Worksheets("算出履歴")
'支給計算
Dim calcSheet As Worksheet
Set calcSheet = ThisWorkbook.Worksheets("支給計算")
'算出されていない場合はメッセージを出す
If Cells(14, 10) = "" Then
MsgBox "算出してください。"
Exit Sub
ElseIf Cells(5, 12) = 0 Or Cells(5, 12) = "" Then
MsgBox "データを入力し、算出を行ってください。"
Exit Sub
ElseIf Cells(11, 6) = "" Then
MsgBox "保存名を入力してください"
Exit Sub
ElseIf Cells(5, 12).Value > 10000 And Cells(7, 4).Value = 1 Then
MsgBox "時給10,000超過。要修正。"
Exit Sub
ElseIf Cells(5, 12).Value < 10000 And Cells(7, 4).Value = 2 Then
MsgBox "月給10,000未満。要修正。"
Exit Sub
End If
' ＝＝＝＝＝＝＝＝＝＝＝＝＝再計算 念のために計算を実行
Call 社会保険料算出_Click
ActiveSheet.Unprotect
' ========================重複のチェック
Dim saveName As String
saveName = Range("F11").Value
Dim kari As Variant
kari = readData(saveName)
If kari(0, 0) <> "nodata" Then 'DB に該当のデータがあるか確認
Call MsgBox("既に使われた保存名です。変更して保存してください。")
ActiveSheet.Protect
Exit Sub
End If
' ========================DBにinsert
Dim str As String 'SQL文を入れる変数
str = makeSQL("insert") 'SQL文生成
execSQL (str) 'insert実行
' ＝＝＝＝＝＝＝＝＝＝＝＝＝履歴データダウンロード・転記
Cells(1, 1).Value = "save" ' save モードであることを記録しておく（writeData で使う）
Call loadHist
calcSheet.Activate
Cells(1, 1).Value = "" '消しておく
ActiveSheet.Protect '支給計算
calcSheet.Range("F11").Select
End Sub Sub loadData() '================このコードは 支給計算シートで実行される ' written by Kasahara 2011/11/21
Application.ScreenUpdating = False '画面描画の停止
'保存名がない場合はエラー
If Cells(11, 6) = "" Then
MsgBox "保存名を入力してください"
Exit Sub
End If
ActiveSheet.Unprotect
' ========================保存名を使って検索
Dim saveName As String
saveName = Range("F11").Value
Dim rData As Variant '検索結果を受ける変数
rData = readData(saveName)
If rData(0, 0) = "nodata" Then 'select の結果データがなかった
Call MsgBox("保存名が見当たりません。修正して再度実行してください。")
ActiveSheet.Protect
Exit Sub
End If
' ＝＝＝＝＝＝＝＝＝＝＝＝＝社会保険計算に必要なデータをセルに入れる ' 受け取ったデータを変数に代入（扱い易いように）
Dim h As keisan h.saveName = rData(0, 0) h.payW = rData(1, 0) h.choiceAge = rData(2, 0) h.workT = rData(3, 0) h.payH = rData(4, 0) h.payM = rData(5, 0) h.transport = rData(6, 0)
' セルに入れる
Cells(11, 6).Value = h.saveName
Cells(7, 4).Value = h.payW
If h.choiceAge = "３９歳以下" Then
Cells(7, 6).Value = 1
Else
Cells(7, 6).Value = 2
End If
Cells(5, 8).Value = h.workT
If h.payW = 1 Then
Call 時給_Click
Cells(5, 12).Value = h.payH
Else
Call 月給_Click
Cells(5, 12).Value = h.payM
End If
Cells(7, 16).Value = h.transport
' ＝＝＝＝＝＝＝＝＝＝＝＝＝再計算
Call 社会保険料算出_Click
Range("F11").Select
ActiveSheet.Protect '支給計算
End Sub
Sub updateData() '================このコードは 支給計算シートで実行される ' written by Kasahara 2011/11/21
Application.ScreenUpdating = False '画面描画の停止
'算出履歴
Dim resultSheet As Worksheet
Set resultSheet = ThisWorkbook.Worksheets("算出履歴")
'支給計算
Dim calcSheet As Worksheet
Set calcSheet = ThisWorkbook.Worksheets("支給計算")
'算出されていない場合はメッセージを出す
If Cells(14, 10) = "" Then
MsgBox "算出してください。"
Exit Sub
ElseIf Cells(5, 12) = 0 Or Cells(5, 12) = "" Then
MsgBox "データを入力し、算出を行ってください。"
Exit Sub
ElseIf Cells(11, 6) = "" Then
MsgBox "保存名を入力してください"
Exit Sub
ElseIf Cells(5, 12).Value > 10000 And Cells(7, 4).Value = 1 Then
MsgBox "時給10,000超過。要修正。"
Exit Sub
ElseIf Cells(5, 12).Value < 10000 And Cells(7, 4).Value = 2 Then
MsgBox "月給10,000未満。要修正。"
Exit Sub
End If
' ＝＝＝＝＝＝＝＝＝＝＝＝＝再計算 念のために計算を実行
Call 社会保険料算出_Click
ActiveSheet.Unprotect
' ========================重複のチェック
Dim saveName As String
saveName = Range("F11").Value
' ========================保存名を使って検索:保存名を書き換えていないかチェック
Dim rData As Variant '検索結果を受ける変数
rData = readData(saveName)
If rData(0, 0) = "nodata" Then 'select の結果データがなかった
Call MsgBox("保存名が見当たりません。修正して再度実行してください。")
ActiveSheet.Protect
Exit Sub
End If
' ======================== 既存データをupdate
Dim str As String 'SQL文を入れる変数
str = makeSQL("update") 'SQL生成
execSQL (str) 'update実行
' ＝＝＝＝＝＝＝＝＝＝＝＝＝履歴データダウンロード・転記
Cells(1, 1).Value = "update" 'update モードであることを記録しておく（writeData で使う） Call loadHist
calcSheet.Activate
ActiveSheet.Protect '支給計算
Cells(1, 1).Value = "" '消しておく
calcSheet.Range("F11").Select
End Sub
Function readData(ByVal saveName As String) As Variant ' written by Kasahara 2011/11/17 ' 指定された一件のデータのみを読み込む。ない場合はその旨を返す。
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝DB接続
Dim db As ADODB.connection 'アクセス用のオブジェクト宣言
Dim openFl As Boolean
openFl = False 'オープンフラグ
'エラー処理の宣言
On Error GoTo ErrorHandler
If db Is Nothing Then 'インスタンスが存在しない場合
Set db = New ADODB.connection 'インスタンス生成
openFl = True 'オープンフラグをTrue
Else 'オブジェクトが存在する場合
If db.State = adStateClosed Then 'コネクション状態がクローズの場合
openFl = True 'オープンフラグオン
End If
End If
If openFl = True Then 'オープンフラグがオンの場合 DB に接続
db.Open "Provider=SQLOLEDB;" & _
"Data Source=MC27;" & _
"Initial Catalog= test;" & _
"User Id=sa;" & _
"Password=MandC_mc27;"
' Call MsgBox("接続されました", vbInformation)
End If
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝SQL実行
Dim rs As ADODB.Recordset 'SQLにアクセスするオブジェクト宣言
Set rs = New ADODB.Recordset 'インスタンス生成
rs.ActiveConnection = db 'dbの接続をrsのActivConnectionにセット
'データ取得SQL文をrsにセット
rs.Source = "SELECT " & _
" * " & _
"FROM " & _
" hoken " & _
" WHERE " & _
" saveName = '" & _
saveName & "' ; "
rs.Open 'SQL実行(select)
Dim notdata(1, 1) As Variant
notdata(0, 0) = "nodata"
If rs.EOF = True Then 'データが存在しない場合はnotdataを返り値に入れる
readData = notdata
Else 'データが存在する場合は読んだデータを返り値に入れる
readData = rs.GetRows
End If
'＝＝＝＝＝＝＝＝＝＝＝＝SQLの後処理
rs.Close 'レコードセットクローズ
Set rs = Nothing 'rsを破棄
If Not db Is Nothing Then 'オブジェクトが存在する場合
'コネクション状態がオープンの場合
If db.State = adStateOpen Then
db.Close 'DBクローズ
End If
Set db = Nothing 'オブジェクト破棄
End If
Exit Function
'エラーの場合 ErrorHandler:
Call MsgBox("エラー" & Err.Number & Chr(13) & Err.Description, vbCritical)
End Function Sub execSQL(str As String) ' written by Kasahara 2011/11/16 ' update,delete,insert で使える
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝DB接続
Dim i As Integer
Dim openFl As Boolean
openFl = False 'オープンフラグ
Dim db As ADODB.connection 'アクセス用のオブジェクト宣言
'エラー処理の宣言
On Error GoTo ErrorHandler
If db Is Nothing Then 'インスタンスが存在しない場合
Set db = New ADODB.connection 'インスタンス生成
openFl = True 'オープンフラグをTrue
Else 'オブジェクトが存在する場合
If db.State = adStateClosed Then 'コネクション状態がクローズの場合
openFl = True 'オープンフラグオン
End If
End If
If openFl = True Then 'オープンフラグがオンの場合 DB に接続
db.Open "Provider=SQLOLEDB;" & _
"Data Source=MC27;" & _
"Initial Catalog= test;" & _
"User Id=sa;" & _
"Password=MandC_mc27;"
' Call MsgBox("接続されました", vbInformation)
End If
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝SQL実行
db.Execute str
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝SQLの後処理
If Not db Is Nothing Then 'オブジェクトが存在する場合
'コネクション状態がオープンの場合
If db.State = adStateOpen Then
db.Close 'DBクローズ
End If
Set db = Nothing 'オブジェクト破棄
End If
Exit Sub
'エラーの場合 ErrorHandler:
Call MsgBox("エラー" & Err.Number & Chr(13) & Err.Description, vbCritical)
End Sub Function makeSQL(syori As String) As String ' written by Kasahara 2022/11/16 insert 文作成 ' modified by Kasahara 2022/11/22 update 追加 '
Dim iStr As String 'SQL文 Dim d As keisan
' シートからデータを取り込む
d.saveName = Range("F11").Value
d.payW = Range("D7").Value
d.choiceAge = Range("F19").Value '年齢
d.workT = Range("G19").Value '時間
If Cells(7, 4).Value = 1 Then
d.payH = Cells(14, 10).Value '時給（交通費無）
d.payM = d.payH * d.workT '月給（交通費無）
Else
d.payM = Cells(5, 12).Value '月給（交通費無）
d.payH = Round(d.payM / d.workT, 0)
End If
d.transport = Cells(7, 16).Value '交通費
d.remuneration = Cells(14, 11).Value '月額報酬
d.health = Range("L14").Value '健康保険
d.welfare = Range("M14").Value '厚生年金
d.care = Range("N14").Value '介護保険
d.job = Range("O14").Value '雇用保険
If syori = "insert" Then
' insert 文作成
iStr = "INSERT INTO hoken" & _
"(saveName, payW,choiceAge,workT,payH,payM,transport,remuneration,health,welfare,care,job) values ("
iStr = iStr & "'" & d.saveName & _
"'," & d.payW & _
",'" & d.choiceAge & _
"'," & d.workT & _
"," & d.payH & _
"," & d.payM
iStr = iStr & "," & d.transport & _
"," & d.remuneration & _
"," & d.health & _
"," & d.welfare & _
"," & d.care & _
"," & d.job & _
");"
Else
' update 文作成
iStr = "UPDATE hoken SET "
iStr = iStr & "saveName= '" & d.saveName & "',"
iStr = iStr & " payW= " & d.payW & ","
iStr = iStr & " choiceAge= '" & d.choiceAge & "',"
iStr = iStr & " workT= " & d.workT & ","
iStr = iStr & " payH= " & d.payH & ","
iStr = iStr & " payM= " & d.payM & ","
iStr = iStr & " transport= " & d.transport & ","
iStr = iStr & " remuneration= " & d.remuneration & ","
iStr = iStr & " health= " & d.health & ","
iStr = iStr & " welfare= " & d.welfare & ","
iStr = iStr & " care= " & d.care & ","
iStr = iStr & " job= " & d.job & ","
iStr = iStr & " cDate= '" & Year(Now) & "-" & Month(Now) & "-" & Day(Now) & " " & hour(Now) & ":" & Minute(Now) & ":" & Second(Now) & ":000'"
iStr = iStr & " WHERE saveName = '" & d.saveName
iStr = iStr & "';"
End If
' Stop
makeSQL = iStr '作ったSQL文を返り値にセット
End Function
Sub loadHist() ' written by Kasahara 2011/11/17 ' 全データをダウンロードして履歴セルに貼り付ける '＝＝＝＝＝＝＝＝＝＝＝＝＝＝DB接続
Dim db As ADODB.connection 'アクセス用のオブジェクト宣言
Dim openFl As Boolean
openFl = False 'オープンフラグ
Dim allData As Variant 'DLデータ受ける変数
'エラー処理の宣言
On Error GoTo ErrorHandler
If db Is Nothing Then 'インスタンスが存在しない場合
Set db = New ADODB.connection 'インスタンス生成
openFl = True 'オープンフラグをTrue
Else 'オブジェクトが存在する場合
If db.State = adStateClosed Then 'コネクション状態がクローズの場合
openFl = True 'オープンフラグオン
End If
End If
If openFl = True Then 'オープンフラグがオンの場合 DB に接続
db.Open "Provider=SQLOLEDB;" & _
"Data Source=MC27;" & _
"Initial Catalog= test;" & _
"User Id=sa;" & _
"Password=MandC_mc27;"
End If
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝SQL実行
Dim rs As ADODB.Recordset 'SQLにアクセスするオブジェクト宣言
Set rs = New ADODB.Recordset 'インスタンス生成
rs.ActiveConnection = db 'dbの接続をrsのActivConnectionにセット
'テストデータ取得SQL文をrsにセット '全件取得
rs.Source = "SELECT " & _
" * " & _
"FROM " & _
" hoken order by cDate desc ;"
rs.Open 'SQL実行
If rs.EOF = True Then 'データがない場合：理論的には存在しない
Call MsgBox("該当データが存在しません")
Exit Sub
Else 'データが存在する場合
allData = rs.GetRows 'GetRowsメソッドでデータを戻り値に格納)
writeData (allData) 'ダウンロードしたデータをシートに転記
End If
'＝＝＝＝＝＝＝＝＝＝＝＝＝＝SQLの後処理
rs.Close 'レコードセットクローズ
Set rs = Nothing 'rsを破棄
If Not db Is Nothing Then 'オブジェクトが存在する場合
'コネクション状態がオープンの場合
If db.State = adStateOpen Then
db.Close 'DBクローズ
End If
Set db = Nothing 'オブジェクト破棄
End If
Exit Sub
'エラーの場合 ErrorHandler:
Call MsgBox("エラー" & Err.Number & Chr(13) & Err.Description, vbCritical)
End Sub
Sub writeData(allData As Variant) ' written by Kasahara 2011/11/17 ' ダウンロードした履歴データをワークシートに転記する ' update by Kasahara 2011/11/17 ' update 対応
Dim RowSize, columnSize, i, j As Long
Dim temp() As Variant '縦と横を入れ替えるために使う
columnSize = UBound(allData, 1)
RowSize = UBound(allData, 2)
ReDim temp(RowSize, columnSize) '縦と横を入れ替えるための設定
For i = 0 To UBound(allData, 1)
For j = 0 To UBound(allData, 2)
temp(j, i) = allData(i, j)
Next j
Next i
'cellに転記
'支給計算シート （直近５件のみ
Sheets("支給計算").Select
ActiveSheet.Unprotect
' どちらのモードで呼ばれたかを読み込む
Dim flg As String
flg = Cells(1, 1).Value
For i = 1 To UBound(temp) + 1
If i > 5 Then
Exit For
End If
Cells(i + 21, 4).Value = temp(i - 1, 12) ' 保存日時
Cells(i + 21, 5).Value = temp(i - 1, 0) ' 保存名
Cells(i + 21, 6).Value = temp(i - 1, 2) ' 年齢
Cells(i + 21, 7).Value = temp(i - 1, 3) ' 時間
Cells(i + 21, 8).Value = temp(i - 1, 6) ' 交通費
Cells(i + 21, 9).Value = temp(i - 1, 5) ' 月給
Cells(i + 21, 10).Value = temp(i - 1, 4) ' 時給
Cells(i + 21, 11).Value = temp(i - 1, 7) ' 報酬月額
Cells(i + 21, 12).Value = temp(i - 1, 8) ' 健康保険
Cells(i + 21, 13).Value = temp(i - 1, 9) ' 厚生年金
Cells(i + 21, 14).Value = temp(i - 1, 10) ' 介護保険料
Cells(i + 21, 15).Value = temp(i - 1, 11) ' 雇用保険
'横計算のセル
Cells(i + 21, 16).Value = Cells(i + 21, 12) + Cells(i + 21, 13) + Cells(i + 21, 14) + Cells(i + 21, 15)
Cells(i + 21, 17).Value = Cells(i + 21, 16).Value + Cells(i + 21, 11).Value '経費合計（交通費有）＝保険合計＋月額報酬
Cells(i + 21, 18).Value = Cells(i + 21, 16).Value + Cells(i + 21, 9).Value '経費合計（交通費無）＝保険合計＋月給
Cells(i + 21, 19).Value = Cells(i + 21, 9).Value - Cells(i + 21, 17).Value '差額交通費有
Cells(i + 21, 20).Value = Cells(i + 21, 11).Value - Cells(i + 21, 17).Value '差額交通費無
Next i
ActiveSheet.Protect
Sheets("算出履歴").Select
ActiveSheet.Unprotect
For i = 1 To UBound(temp) + 1
Cells(i + 5, 4).Value = temp(i - 1, 12) ' 保存日時
Cells(i + 5, 5).Value = temp(i - 1, 0) ' 保存名
Cells(i + 5, 6).Value = temp(i - 1, 2) ' 年齢
Cells(i + 5, 7).Value = temp(i - 1, 3) ' 時間
Cells(i + 5, 8).Value = temp(i - 1, 6) ' 交通費
Cells(i + 5, 9).Value = temp(i - 1, 5) ' 月給
Cells(i + 5, 10).Value = temp(i - 1, 4) ' 時給
Cells(i + 5, 11).Value = temp(i - 1, 7) ' 報酬月額
Cells(i + 5, 12).Value = temp(i - 1, 8) ' 健康保険
Cells(i + 5, 13).Value = temp(i - 1, 9) ' 厚生年金
Cells(i + 5, 14).Value = temp(i - 1, 10) ' 介護保険料
Cells(i + 5, 15).Value = temp(i - 1, 11) ' 雇用保険
'横計算のセル
Cells(i + 5, 16).Value = Cells(i + 5, 12) + Cells(i + 5, 13) + Cells(i + 5, 14) + Cells(i + 5, 15)
Cells(i + 5, 17).Value = Cells(i + 5, 16).Value + Cells(i + 5, 11).Value '経費合計（交通費有）＝保険合計＋月額報酬
Cells(i + 5, 18).Value = Cells(i + 5, 16).Value + Cells(i + 5, 9).Value '経費合計（交通費無）＝保険合計＋月給
Cells(i + 5, 19).Value = Cells(i + 5, 9).Value - Cells(i + 5, 17).Value '差額交通費有
Cells(i + 5, 20).Value = Cells(i + 5, 11).Value - Cells(i + 5, 17).Value '差額交通費無
Next i
' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝ update の場合は件数が変わらないので以下の処理は行わない
If flg = "save" Then
'履歴の最終行に番号を追加
Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Value = (Cells(Rows.Count, 3).End(xlUp).Value + 1)
Dim lastRange As Range
Set lastRange = Range(Cells(Rows.Count, 3).End(xlUp), Cells(Rows.Count, 20).End(xlUp))
lastRange.Offset(-1, 0).Borders(xlEdgeBottom).LineStyle = False
lastRange.Offset(-1, 0).Copy
lastRange.PasteSpecial Paste:=xlPasteFormats
lastRange.Offset(-1, 0).Borders(xlEdgeBottom).LineStyle = False
'５行ごとに水平の罫線を上部へ追加
If Cells(Rows.Count, 3).End(xlUp).Value Mod 5 = 1 Then
lastRange.Borders(xlEdgeTop).LineStyle = True
lastRange.Borders(xlEdgeTop).ColorIndex = 2
End If
'最下部の罫線を追加
lastRange.Borders(xlEdgeBottom).LineStyle = True
lastRange.Borders(xlEdgeBottom).ColorIndex = 2
lastRange.Borders(xlEdgeLeft).LineStyle = True
lastRange.Borders(xlEdgeRight).LineStyle = True
End If
ActiveSheet.Protect '算出履歴
End Sub
Sub 以上_Click() End Sub Sub 以下_Click() End Sub
