[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『マクロで保存・終了できないようにしたい』（ひで）
お世話になります。職場の人で困っている人がいてマクロ処理したいのですが，協力をお願いできますでしょうか。
ある範囲 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
なので抑止は諦めて、集計する前等に、半角に変えるマクロを流すのが良いかと思いますよ。
（???） 2016/03/08(火) 14:36
実は皆さん懸念されていることを心配しています。先方は自分で編集してコピー貼り付けしますので，なんともならないのです。
終了するときとか上書き保存直前に強制半角マクロも考えたのですが，
なんと言っても本人に「半角入力で！」を自覚させたいのです。
そのために全角で入力したまま保存しようとしたらメッセージが出るとか，
保存できないようにするか何かないかな？と考えました。
何かいい方法はないでしょうか。
（ひで） 2016/03/08(火) 17:04
アクセスに変えたらどうでしょう？ （稲葉） 2016/03/08(火) 17:13
まだあった １）シートをパスワード付きで保護して、マクロ有効ではないと入力できないようにする。 ２）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
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.