**NO８**
「DATA見積」

元々のマクロは黒文字で、それに追加した説明は青色とします。
マクロの中で、頭に　'　　がある行は注釈文字列になり、マクロの実行には影響しません。

Private Sub CommandButton3_Click()
　　クリア一行1
End Sub

Private Sub CommandButton2_Click()
　　クリアDATA
End Sub

元々のマクロは黒文字で、それに追加した説明は青色とします。
マクロの中で、頭に　'　　がある行は注釈文字列になり、マクロの実行には影響しません。

Sub クリアDATA()
'
' Macro1 Macro
''
　　Application.ScreenUpdating = False

　　Dim ans As String

　　　MsgBox "全部のデータの消去です。よく考えて実行しましょう。"

　　　ans = MsgBox("すべてのデータを本当に消去していいですか？", vbOKCancel, "消去の確認")

　　　If ans = vbCancel Then
　　　　　　Exit Sub
　　　End If

　　ActiveSheet.Unprotect

　　Range("B9:CK1008").Select
　　Selection.ClearContents

　　Range("A4").Select

　　ActiveSheet.Protect

End Sub

'
'「ＤＡＴＡ見積」用
'
Sub クリア一行1()
'
'カーソルのある行のデータを消去します。
'
　　Application.ScreenUpdating = False

　　Dim R1 As Integer
　　Dim C1 As Integer
　　Dim Sn As String
　
　　R1 = ActiveCell.Row　　　　　　　　　 '現在のセルの位置の行番号
　　C1 = ActiveCell.Column　　　　　　　 '現在のセルの位置の列番号
　　Sn = ActiveSheet.Name　　　　　　　 '現在のシートの名前

下の５行はプログラム作成時点で、変数の確認するためのチェック用のもの。
完成後は削除しても良いのですが、削除しないで注釈文字列にしています。
' MsgBox R1
' MsgBox "B" & R1
' MsgBox "D" & R1 & ":I" & R1
' MsgBox Sn
　　
' Stop

　　注意のメッセージの表示
　　MsgBox "データの消去には、十分注意が必要です。"

ＩＦ　ＥｎｄＩｆ　が2重になっています。

　　　If R1 < 9 Or Sn <> "DATA見積" Then　　　　　　　　　　　 '8行以下やシート名のチェック
　　　　　　MsgBox "この行のデータは消去できません", 0 + 48, "確認"
　　　Else

　　　　　　　MsgBox R1 - 8 & "　番目のデータの消去です。"　

　　　　　　　Dim ans As String
　　　　　　　ans = MsgBox("本当に消去していいですか？", vbOKCancel, "消去の確認")

　　　　　　　　If ans = vbOK Then
　　　　　　　　　　　ActiveSheet.Unprotect　　　　　　　　　　　　　　 'F列から
　　　　　　　　　　　Range("F" & R1 & ":CK" & R1) = ""
　　　　　　　　　　　ActiveSheet.Protect　　　　

　　　　　　　　　　　Cells(R1, 1).Select　　　　　　　　　　　　　　　　 'カーソルをA列に設置

　　　　　　　　End If

　　　End If

End Sub
'
'

「ＤＡＴＡ請求」用
'
Sub クリア一行2()
'
'カーソルのある行のデータを消去します。
'
　　Dim R1 As Integer
　　Dim C1 As Integer
　　Dim Sn As String

　　R1 = ActiveCell.Row　　　　　　　　 '現在のセルの位置の行番号
　　C1 = ActiveCell.Column　　　　　　 '現在のセルの位置の列番号
　　Sn = ActiveSheet.Name　　　　　　 '現在のシートの名前

下の５行はプログラム作成時点で、変数の確認するためのチェック用のもの。
完成後は削除しても良いのですが、削除しないで注釈文字列にしています。
' MsgBox R1
' MsgBox "B" & R1
' MsgBox "D" & R1 & ":I" & R1
' MsgBox Sn

' Stop
　　
　　　　MsgBox "データの消去には、十分注意が必要です。"

　　　　　If R1 < 9 Or Sn <> "DATA請求" Then　　　　　　　　　　　　'8行以下やシート名のチェック
　　　　　　　　MsgBox "この行のデータは消去できません", 0 + 48, "確認"
　　　　　Else

　　　　　　　MsgBox R1 - 8 & "　番目のデータの消去です。"
　
　　　　　　　Dim ans As String
　　　　　　　ans = MsgBox("本当に消去していいですか？", vbOKCancel, "消去の確認")

　　　　　　　If ans = vbOK Then

　　　　　　　　　ActiveSheet.Unprotect　　　　　　　　　　　　　　　　　 'F列から
　　　　　　　　　Range("F" & R1 & ":CK" & R1) = ""
　　　　　　　　　ActiveSheet.Protect

　　　　　　　　　Cells(R1, 1).Select　　　　　　　　　　　　　　　　　　　　 'カーソルをA列に設置

　　　　　　　End If

　　　End If

End Sub
'
'

見積書請求書作成V2.0