『マクロで保存・終了できないようにしたい』（ひで）

お世話になります。職場の人で困っている人がいてマクロ処理したいのですが，協力をお願いできますでしょうか。
ある範囲　A1：C40 
には半角英数字を入れて欲しいのですが，
何度言っても全角で入力する人がいます。

そのため，この範囲に全角英数字が入力された状態で，上書き保存しようとするとか
×印を押そうとしたりしたときに

半角でないので保存できない！旨のメッセージと共に保存できないようにするマクロって可能でしょうか。
よろしくお願いいたします。




＜ 使用 Excel：Excel2013、使用 OS：Windows8 ＞
----
 別方向の回答だが。
 A1:C40を選択してデータ-データの入力規則-日本語入力を無効にしてはどうだろうか？

 そうするとそのセル範囲ではIMEが効かなくなるので半角英数字しか手入力できない。

 もっとも他からコピーしてきて張り付けることはできるが。
（ねむねむ） 2016/03/08(火) 11:04
----
 ねむねむさんの方法が一番いいかと思いますが、全角で入力しても自動的に半角になる
 マクロのコードを一応書いておきます。

 シートモジュールに下記コード貼り付け

 Private Sub Worksheet_Change(ByVal Target As Range)

      Dim r As Range

      If Intersect(Target, Range("A1:C40")) Is Nothing Then Exit Sub
     
      For Each r In Range("A1:C40")
          Application.EnableEvents = False
          If r.Value <> "" Then r.Value = StrConv(r.Value, vbNarrow)
          Application.EnableEvents = True
      Next

 End Sub

 マクロ無効にされたら何の意味もないですが･･･。
（se_9） 2016/03/08(火) 11:13
----
 別案
 条件付き書式で、A1:C40を選択して数式に
 =LENB(A1)<>LENB(ASC(A1))
 として塗りつぶしで赤にするなど、いかがですか？
 気づきやすいですよ。
 コピー貼付されるとだめですが！

 あとは、入力すると変換もいいですが、保存するときでも良いかなと。
 ThisWorkbookモジュールに
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
        Sheets("Sheet1").Range("A1:C40").Value = Evaluate("ASC(Sheet1!A1:C40)")
    End Sub

 
（稲葉） 2016/03/08(火) 12:50
----
ウィルス対策のため、現在のExcelは、起動時にマクロの実行をするかどうか尋ねるようになっています。
このため、どんなに全角抑止のマクロを用意しても、マクロ無効で起動されて入力されるとお手上げです。

なので抑止は諦めて、集計する前等に、半角に変えるマクロを流すのが良いかと思いますよ。
（???） 2016/03/08(火) 14:36
----
皆さんありがとうございます。

実は皆さん懸念されていることを心配しています。先方は自分で編集してコピー貼り付けしますので，なんともならないのです。

終了するときとか上書き保存直前に強制半角マクロも考えたのですが，

なんと言っても本人に「半角入力で！」を自覚させたいのです。

そのために全角で入力したまま保存しようとしたらメッセージが出るとか，

保存できないようにするか何かないかな？と考えました。

何かいい方法はないでしょうか。
（ひで） 2016/03/08(火) 17:04
----
 アクセスに変えたらどうでしょう？
（稲葉） 2016/03/08(火) 17:13
----
IMEの設定を変えさせてもらって、「オートコレクト」で数字と英字を「常に半角に変換」とするとか？
（???） 2016/03/08(火) 17:22
----
 まだあった
 １）シートをパスワード付きで保護して、マクロ有効ではないと入力できないようにする。
 ２）WorkBookOpenイベントでシートの保護をUserInterFaceOnlyに変更し
 ３）範囲をクリックすると、ユーザーフォームが表示されて、セルではなくフォームに入力してもらう
 ４）フォームの入力ボタンを押したときに、全角文字が含まれていたら警告を出す。
 　　（あえて変換してから入力せず、警告だけ）
 ５）面倒だと怒り始めたら、半角入力を約束させて、それらの設定を解除する

 
 
（稲葉） 2016/03/08(火) 17:28
----
 >>なんと言っても本人に「半角入力で！」を自覚させたいのです。 

 自覚させるには、最後の保存の時より、入力した時のほうが、【あっ！いてて！！】と身につくと思います。
 なので、回答にある　入力規則がいいのでは？

 なぜ、保存時のチェックにこだわるのですか？

（β） 2016/03/08(火) 17:30
----
入力規則案は、コピペされるから駄目、という事でしたよね。

あとは、本人にどうしても半角入力させるように矯正したい！、というならば、管理者権限で、違反した場合は減俸！、とか命令するとか？
修正のために余分な工数が発生するのだから、そんなに無茶な話ではないかと。
（???） 2016/03/08(火) 17:41
----
 保存時に直せって言ったほうが、まあダメージは大きいでしょうねぇ。
 上で提案した案、具体的にやってみたら割と使えるかも？
 ThisWorkBookモジュール
 Sheet1は入力させるシートで。
    Option Explicit
    
    Private Sub Workbook_Open()
        Sheets("Sheet1").Protect Password:="1234", userinterfaceonly:=True
    End Sub

 入力させるSheetモジュール
    Option Explicit
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Not Intersect(Range("A1:C40"), Target) Is Nothing Then
            UserForm1.TextBox1.Value = Target.Value
            UserForm1.Show vbModal
        End If
    End Sub

 UserFormを一つ追加し、テキストボックスとコマンドボタンを一つずつ置く
 UserForm1にに、以下のコード

    Option Explicit
    
    Private Sub CommandButton1_Click()
        If Evaluate("LenB(""" & TextBox1.Value & """)") <> Evaluate("LenB(""" & StrConv(TextBox1.Value, vbNarrow) & """)") Then
            MsgBox "半角で入力してください", vbCritical
        Else
            Selection.Value = TextBox1.Value
            Unload Me
        End If
    End Sub

（稲葉） 2016/03/08(火) 17:46
----
 >>入力規則案は、コピペされるから駄目、という事でしたよね

 あっ、読んでませんでした。（ぺこり）

 では、気づきは（コピペされたときも含んで）入力時。
 チェックは保存時で。（xl2013 だということで）

 ●シートモジュール

 Private Sub Worksheet_Change(ByVal Target As Range)
    With Range("A1:C40")
        If Intersect(Target, .Cells) Is Nothing Then Exit Sub
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=LENB(A1)<>LEN(A1)"
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 255
            .TintAndShade = 0
        End With
    End With
 End Sub

 ●ThisWorkbookモジュール

 Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim idx As Variant
    Dim er As Boolean
    
    idx = Sheets("Sheet1").Range("A1:C40").DisplayFormat.Interior.ColorIndex    '★対象シート名は実際のものに
    If IsNull(idx) Then
        er = True
    ElseIf idx <> xlNone Then
        er = True
    End If
    
    If er Then
        MsgBox "全角文字入力は禁止だって言ったでしょ！！！"
        Cancel = True
    End If
        
 End Sub

（β） 2016/03/08(火) 19:12