商品代を税別金額で揃えるためのVBA 3点伝票日付版

Sub 通番再配置()
    Dim NoRow, i As Long
        If ActiveSheet.Name = "作業シート" Or ActiveSheet.Name = _
                    "外税計算" Then
            With ActiveSheet
                .Range("A:A").ClearContents
                NoRow = .Cells(Rows.Count, 5).End(xlUp).Row
                For i = 2 To NoRow
                    .Cells(i, 1) = i - 1
                Next i
            End With
        End If
End Sub

Sub チェックボックス内税配置()
    Dim SzRow, URow, i As Long
    Dim Tgrange As Range
    Dim CB As checkbox
        With Worksheets("外税計算")
            .Select
'外税計算シートでのデータ入力の最終行数
        SzRow = Cells(Rows.Count, 5).End(xlUp).Row
'外税計算シートでの使用セルの最終行
            URow = .UsedRange.Rows.Count
        End With
'内税チェックボックスを一旦削除
            Range(Cells(2, 2), Cells(URow, 2)).Select
            For Each Tgrange In Selection
                With Tgrange
                    For Each CB In Worksheets("外税計算").CheckBoxes
                            If Not Application.Intersect(CB.TopLeftCell, _
                                        Tgrange) Is Nothing Then
                                CB.Delete
                            End If
                    Next CB
                End With
            Next Tgrange
'内税チェックボックスをデータ数だけ設置
        For i = 2 To SzRow
            With Cells(i, 2)
'各セルにチェックボックスを配置しセルのサイズを調整
                ActiveSheet.CheckBoxes.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .LinkedCell = Cells(i, 2).Address
                End With
'文字色を白色に変更
                .Font.Color = RGB(255, 255, 255)
            End With
        Next i
End Sub

Sub チェック8内税配置()
    Dim SzRow, URow, i As Long
    Dim Tgrange As Range
    Dim CB As checkbox
        With Worksheets("外税計算")
            .Select
'外税計算シートでのデータ入力の最終行数
        SzRow = Cells(Rows.Count, 5).End(xlUp).Row
'外税計算シートでの使用セルの最終行
            URow = .UsedRange.Rows.Count
        End With
'8%内税チェックボックスを一旦削除
            Range(Cells(2, 3), Cells(URow, 3)).Select
            For Each Tgrange In Selection
                With Tgrange
                    For Each CB In Worksheets("外税計算").CheckBoxes
                        If Not Application.Intersect(CB.TopLeftCell, _
                                    Tgrange) Is Nothing Then
                            CB.Delete
                        End If
                    Next CB
                End With
            Next Tgrange
'8%内税チェックボックスをデータ数だけ設置
        For i = 2 To SzRow
            With Cells(i, 3)
'各セルにチェックボックスを配置しセルのサイズを調整
                ActiveSheet.CheckBoxes.Add(.Left, .Top, _
                            .Width, .Height).Select
                With Selection
                    .Characters.Text = ""
                    .LinkedCell = Cells(i, 3).Address
                End With
'文字色を白色に変更
                .Font.Color = RGB(255, 255, 255)
            End With
        Next i
End Sub

Sub 税別化転送()
    Dim SkRow, i As Long
        With Worksheets("外税計算")
            SkRow = .Cells(Rows.Count, 5).End(xlUp).Row
            For i = 2 To SkRow
                If .Cells(i, 2) = True Then
                    With .Cells(i, 7)
                        .Offset(0, 2) = .Value
                        If Worksheets("外税計算") _
                                    .Cells(i, 3) = True Then
                            CellV = .Value
                            Call CulcruleA8(CellV)
                            .Value = Sk8Tx
                        Else
                            CellV = .Value
                            Call CulcruleA10(CellV)
                            .Value = Sk10Tx
                        End If
                        .Offset(0, 1) = .Value * _
                        Worksheets("外税計算").Cells(i, 5)
                    End With
                End If
            Next i
            .Range(.Cells(2, 3), .Cells(SkRow, 8)).Copy _
                        Worksheets("作業シート").Range("C2")
            .Range("A1").Select
        End With
        With Worksheets("作業シート")
            .Select
            .Columns("D").AutoFit
            .Range("A1").Select
        End With
        MsgBox "内税から外税に変更した元単価は、" & vbCrLf & _
            "「外税計算シート 備考欄」で確認出来ます。", _
                vbInformation, "インボイス見積納品請求3点日付版作成"
End Sub