Sub 見積書作成()

Dim WS1 As Worksheet
Dim LCRN1 As Long
Dim AllRow As Long

AllRow = ActiveSheet.Rows.Count '全ての行数

Set WS1 = Worksheets("見積入力")

'未入力回避

If WS1.Range("D3") = "" Then

    MsgBox "見積先が入力されていません"
    Exit Sub

End If

If WS1.Range("H5") = 0 Then

    MsgBox "単価か数量が入力されていません"
    Exit Sub

End If


'見積番号を取得する
Dim WS3 As Worksheet
Dim LCRN3 As Long
Set WS3 = Worksheets("番号簿")
LCRN3 = WS3.Cells(AllRow, 1).End(xlUp).Row + 1

Dim RefNum As String '見積番号用の変数名

RefNum = "M" & LCRN3 - 3 '番号簿の行番号-3

'番号簿に履歴を残す
WS3.Cells(LCRN3, 1) = RefNum
WS3.Cells(LCRN3, 2) = Date
WS3.Cells(LCRN3, 3) = WS1.Range("D3")
WS3.Cells(LCRN3, 4) = WS1.Range("H5")
WS3.Cells(LCRN3, 4) = WS1.Range("H3")

'見積履歴を保存する
Dim WS4 As Worksheet
Dim LCRN4 As Long
Set WS4 = Worksheets("見積履歴")

'履歴を取るために、入力してある最終行を調べる
LCRN1 = WS1.Cells(AllRow, 3).End(xlUp).Row

Dim N1 As Integer '行番号指定用の変数
Dim J1 As Integer '列番号指定用の変数

For N1 = 8 To LCRN1

    LCRN4 = WS4.Cells(AllRow, 1).End(xlUp).Row + 1 '履歴に追加する行を取得
    WS4.Cells(LCRN4, 1) = RefNum '見積番号
    WS4.Cells(LCRN4, 2) = Date '日付
    WS4.Cells(LCRN4, 3) = WS1.Range("D3") '見積先
    WS4.Cells(LCRN4, 4) = WS1.Range("D4") '見積先担当者
    WS4.Cells(LCRN4, 5) = WS1.Range("D5") '見積作成者
    
    For J1 = 3 To 8
    
        WS4.Cells(LCRN4, J1 + 3) = WS1.Cells(N1, J1)

    Next J1
    
    WS4.Cells(LCRN4, 12) = WS1.Range("H3") '見積件名
    
Next N1


Dim WB1 As Workbook
Set WB1 = ActiveWorkbook

'見積書の原紙をコピーする

Worksheets("見積書原紙").Copy
ActiveSheet.Name = RefNum

Dim WS5 As Worksheet
Dim WB2 As Workbook

Set WB2 = ActiveWorkbook
Set WS5 = ActiveSheet

Dim LCRN5 As Long

'入力シートのデータを、見積書に転記していく

WS5.Range("G1") = RefNum '見積番号
WS5.Range("G2") = Date '見積番号

WS5.Range("G7") = WS1.Range("D5") '見積作成者

If WS1.Range("D4") = "" Then '見積先担当者が不在の場合

    WS5.Range("B3") = WS1.Range("D3") & " 御中" '見積先
    WS5.Range("B4") = ""    '見積先担当者
    
    Else
    
    WS5.Range("B3") = WS1.Range("D3")  '見積先
    WS5.Range("B4") = WS1.Range("D4") & " 様"  '見積先担当者

End If

WS5.Range("D32") = WS1.Range("H3") '見積件名

For N1 = 8 To LCRN1

    LCRN5 = WS5.Cells(28, 3).End(xlUp).Row + 1 '見積書に追加する行を取得
 
    WS5.Cells(LCRN5, 3) = WS1.Cells(N1, 3) '商品コード
    WS5.Cells(LCRN5, 4) = WS1.Cells(N1, 4) '商品名
    WS5.Cells(LCRN5, 5) = WS1.Cells(N1, 5) '数量
    WS5.Cells(LCRN5, 6) = WS1.Cells(N1, 7) '見積単価
    
Next N1

'見積書を別名で保存する
Dim FName As String

'ファイル名を、見積番号と見積先、案件名とする
FName = RefNum & "-" & WS1.Range("D3") & " " & WS1.Range("H3")

ActiveWorkbook.SaveAs FName

Range(WS1.Cells(3, 4), WS1.Cells(5, 4)).ClearContents '見積先から作成者までをクリア
WS1.Range("H3") = "" '件名をクリア
Range(WS1.Cells(8, 3), WS1.Cells(19, 3)).ClearContents '商品コードをクリア
Range(WS1.Cells(8, 5), WS1.Cells(19, 5)).ClearContents '数量をクリア
Range(WS1.Cells(8, 7), WS1.Cells(19, 7)).ClearContents '見積単価をクリア


End Sub