'========================================================================================= ' 126 入力可能な文字数を制限する '----------------------------------------------------------------------------------------- '【ヒント】 ' このマクロは、おためし機能の動作用のコードです。 ' タイトル機能に関係するコードは、UserForm1のコード画面にあります。 '========================================================================================= ' ◆標準モジュールのコード◆ '----------------------------------------------------------------------------------------- Sub おためしマクロ() Worksheets("Title").Select Range("N1").Select 'カーソルを定位置へ移動する UserForm1.Show vbModeless 'ユーザーフォームをモードレスで表示する End Sub '----------------------------------------------------------------------------------------- Sub Auto_Close() Application.DisplayAlerts = False '閉じる際に確認メッセージを出さない ActiveWorkbook.Close '現在開いているブックを閉じる End Sub '----------------------------------------------------------------------------------------- '========================================================================================= ' ◆UserForm1のコード◆ '----------------------------------------------------------------------------------------- Option Explicit Dim 種類 As Long Dim エラースタイル As Long Dim 条件 As Long Dim 範囲1 As String Dim 範囲2 As String Dim 空白無視指定 As Boolean Dim 入力タイトル As String Dim エラータイトル As String Dim 入力メッセージ As String Dim エラーメッセージ As String Dim IMEモード As Long Dim 入力メッセージ表示指定 As Boolean Dim エラーメッセージ表示指定 As Boolean '----------------------------------------------------------------------------------------- Private Sub OptionButton1_Click() '◆◆◆ 入力規則を設定する ActiveSheet.Unprotect 'シート保護を解除する Range("I9:I16").Select 'クリアする範囲を選択する 入力規則をすべてクリアする 入力規則の共通事項を準備する 入力規則を設定する_ケースA 入力規則を設定する_ケースB 入力規則を設定する_ケースC 入力規則を設定する_ケースD 入力規則を設定する_ケースE 入力規則を設定する_ケースF 入力規則を設定する_ケースG 入力規則を設定する_ケースH Range("N1").Select 'カーソルを低位置へ ActiveSheet.Protect 'シート保護を保護する End Sub '----------------------------------------------------------------------------------------- Private Sub OptionButton2_Click() '◆◆◆ 入力規則をすべてクリアする ActiveSheet.Unprotect 'シート保護を解除する Range("I9:I16").Select 'クリアする範囲を選択する 入力規則をすべてクリアする ActiveSheet.Protect 'シート保護を保護する End Sub '----------------------------------------------------------------------------------------- Private Sub UserForm_Deactivate() Unload Me 'ユーザーフォームをメモリから削除する End Sub '----------------------------------------------------------------------------------------- Private Sub 入力規則をすべてクリアする() With Selection.Validation .Delete .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _ :=xlBetween .IgnoreBlank = True .InCellDropdown = True .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True End With End Sub '----------------------------------------------------------------------------------------- Sub 入力規則の共通事項を準備する() 種類 = xlValidateTextLength '文字列(長さ設定) エラースタイル = xlValidAlertStop 空白無視指定 = True '空白値を可能する 入力タイトル = "500連発 第2弾 サンプルマクロ" エラータイトル = 入力タイトル IMEモード = xlIMEModeNoControl 'コントロールなし 入力メッセージ表示指定 = True 'する エラーメッセージ表示指定 = True 'する End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定する_ケースA() Range("I9").Select '設定するセルを選択する 条件 = xlBetween '次の値の間 範囲1 = "1" 範囲2 = "3" 入力メッセージ = "1文字から3文字" エラーメッセージ = "「" & 入力メッセージ & "」でないのでエラー" 入力規則を設定するプロシージャー End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定するプロシージャー() If 条件 = xlBetween Or 条件 = xlNotBetween Then 入力規則を設定するプロシージャー_間条件 Else 入力規則を設定するプロシージャー_間条件以外 End If End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定するプロシージャー_間条件() With Selection.Validation .Delete .Add Type:=種類, AlertStyle:=エラースタイル, _ Operator:=条件, Formula1:=範囲1, Formula2:=範囲2 .IgnoreBlank = 空白無視指定 .InputTitle = 入力タイトル .ErrorTitle = エラータイトル .InputMessage = 入力メッセージ .ErrorMessage = エラーメッセージ .IMEMode = IMEモード .ShowInput = 入力メッセージ表示指定 .ShowError = エラーメッセージ表示指定 End With End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定するプロシージャー_間条件以外() With Selection.Validation .Delete .Add Type:=種類, AlertStyle:=エラースタイル, _ Operator:=条件, Formula1:=範囲1 .IgnoreBlank = 空白無視指定 .InputTitle = 入力タイトル .ErrorTitle = エラータイトル .InputMessage = 入力メッセージ .ErrorMessage = エラーメッセージ .IMEMode = IMEモード .ShowInput = 入力メッセージ表示指定 .ShowError = エラーメッセージ表示指定 End With End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定する_ケースB() Range("I10").Select 条件 = xlNotBetween '次の値の間以外 範囲1 = "2" 範囲2 = "3" 入力メッセージ = "2文字から3文字以外" エラーメッセージ = "「" & 入力メッセージ & "」でないのでエラー" 入力規則を設定するプロシージャー End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定する_ケースC() Range("I11").Select 条件 = xlEqual '次の値に等しい 範囲1 = "3" 入力メッセージ = "3文字" エラーメッセージ = "「" & 入力メッセージ & "」でないのでエラー" 入力規則を設定するプロシージャー End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定する_ケースD() Range("I12").Select 条件 = xlNotEqual '次の値に等しくない 範囲1 = "3" 入力メッセージ = "3文字以外" エラーメッセージ = "「" & 入力メッセージ & "」でないのでエラー" 入力規則を設定するプロシージャー End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定する_ケースE() Range("I13").Select 条件 = xlGreater '次の値より大きい 範囲1 = "3" 入力メッセージ = "3文字より大きい" エラーメッセージ = "「" & 入力メッセージ & "」でないのでエラー" 入力規則を設定するプロシージャー End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定する_ケースF() Range("I14").Select 条件 = xlLess '次の値より小さい 範囲1 = "3" 入力メッセージ = "3文字より小さい" エラーメッセージ = "「" & 入力メッセージ & "」でないのでエラー" 入力規則を設定するプロシージャー End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定する_ケースG() Range("I15").Select 条件 = xlGreaterEqual '次の値以上 範囲1 = "3" 入力メッセージ = "3文字以上" エラーメッセージ = "「" & 入力メッセージ & "」でないのでエラー" 入力規則を設定するプロシージャー End Sub '----------------------------------------------------------------------------------------- Sub 入力規則を設定する_ケースH() Range("I16").Select 条件 = xlLessEqual '次の値以下 範囲1 = "3" 入力メッセージ = "3文字以下" エラーメッセージ = "「" & 入力メッセージ & "」でないのでエラー" 入力規則を設定するプロシージャー End Sub '=========================================================================================