プロが教える店舗&オフィスのセキュリティ対策術

セル番地データをファイル名にするマクロを作成したいと思い、ユーザーフォームからセル番地データを入力できるようにテキストボックスを作りました。しかし、使用する人がセル番地「aaa」や「abvd」など番地では無いデータを入力する可能性があり、制限する方法が難しいです。
ISREF関数を使いましたが、エラー処理のコメントアウトで何時間も悩んでおります。どなたかご教示お願致します。

Private Sub Execution_Click()

Dim code, Name As String
Dim wb1, wb2 As Workbook

Dim ExtentionName As String
Dim fso As New FileSystemObject

'定数の宣言
Const folderpath As String = "C:\Users\_\Desktop\test1"

'エラー処理

If [IsRef(TextBox1.Value)] = True Or [IsRef(TextBox2.Value)] = True Then

Else
MsgBox ("適切なセル形式を入力してください")
Exit Sub
End If

filePath = Dir(folderpath & "\" & "*.xls") 'フォルダの中のファイル名を返します

'------------------------------フォルダ内部処理----------------------------------

Do While filePath <> "" '変数に空白が入るまで処理を繰り返す

If filePath <> Application.ThisWorkbook.Name Then 'マクロ実行ファイル以外を処理

Workbooks.Open Filename:=ThisWorkbook.path & "\" & filePath

Set wb1 = ThisWorkbook 'このブック
Workbooks.Open ThisWorkbook.path & "\" & filePath '別ブック
Workbooks(filePath).Activate
Set wb2 = ActiveWorkbook


'--------ファイル内部処理---------

code = wb2.Worksheets(1).Range(TextBox1.Value).Value
Name = wb2.Worksheets(1).Range(TextBox2.Value).Value


'--------ファイル内部処理---------


Workbooks(filePath).Close Savechanges:=False

ExtentionName = fso.GetExtensionName(filePath) '拡張子取得

Dim OldName
Dim NewName

OldName = ThisWorkbook.path & "\" & filePath
NewName = ThisWorkbook.path & "\" & code & "_" & Name & "." & ExtentionName
'filePath = code & "_" & Name & "." & ExtentionName


If fso.FileExists(NewName) Then 'newname があるかないか
'書き変えない
Else
Name OldName As NewName 'ファイル名変更
End If

End If

'直前に指定したファイル名が指定されたものとして、まだ返していないファイル名を順に返す
filePath = Dir()

Loop 'Do While に戻る

'------------------------------フォルダ内部処理----------------------------------
End Sub

質問者からの補足コメント

  • うーん・・・

    回答ありがとうございます。
    早速試しましたが、今度はTextBox1又はTextBox2が空白だった場合、If Evaluate・・・で「型が一致しません」と出てしまいます。

    No.2の回答に寄せられた補足コメントです。 補足日時:2022/11/15 15:57
  • うーん・・・

    ひとまずは、fujillinさんのコードで対処してみたいと思います。
    ただ、片方が空白だった場合のエラー処理やファイル名のアンダーバー「_」をどうするかが、問題となっているところです。

    No.4の回答に寄せられた補足コメントです。 補足日時:2022/11/17 12:13

A 回答 (6件)

>Qchan1962さんのコードが難しく感じていまして、中々解読できないでいます。


申し訳ないです。。すこし説明を加えます
メイン処理の実行時ではなくTextBox入力時にチェックする場合の例でした

ユーザーフォームを表示する時にExecution(ボタン?)を使えなくします
(いきなりボタンを押下した時の不具合を避ける為、コード内で抜けても良いけれど)
Private Sub UserForm_Initialize()
Execution.Enabled = False

TextBoxの入力が終わったらチェックします。正しくは
TextBox1またはTextBox2を入力して他のコントロールに移る時に
(Private Sub TextBox?_Exit(ByVal Cancel As MSForms.ReturnBoolean)
が実行されます
ここで IsRefCheck(TextBox1.Value) 
入力チェックのPublic Function IsRefCheck(strV)が実行されチェックされます 
NGの場合 Msgboxが表示されFalseが返るので
フォーカスを戻す(正しくはExitをCancel)して当該TextBoxにカーソルを戻します(クリアーも出来るのでした方が良いかも)

2回書いて分かりずらくなってしまったかも・・
使うのであればこちらの例(Elseがあるイベントプロシージャ)
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsRefCheck(TextBox1.Value) = False Then
Cancel = True
Else
If TextBox2.Value <> "" Then Execution.Enabled = True
End If
End Sub

Private Sub TextBox2_Exit ・・・
これも書き方変えたので判り難かったかも・・
If Not IsRefCheck(TextBox2.Value) Then
If IsRefCheck(TextBox1.Value) = False Then は同じ結果を返します
IsRefCheckがTrueでなければ(Not True)
IsRefCheckがFalseならば

このチェックが各TextBoxでTrueならば対のTextBoxは空白でないので
If TextBox1.Value <> "" Then Execution.Enabled = True
If TextBox2.Value <> "" Then Execution.Enabled = True
ボタンを押せるように設定します

あくまでこの場合の例として
Private Sub Execution_Click()には、実行できる状態である事から
既にチェック済みなのでチェック処理は必要ありません
ただ、実行完了時にTextBoxの値をクリアーしたり自身のトリガーボタンを
.Enabled = Falseにする必要があると思われます

試みたけれど上手く説明できない・・
余計に判り難くなったらごめんなさい・・
    • good
    • 0

空白だった場合・・単純にIFで条件分岐を加えれば良いのでは?



思うのだけれど・・#2にも書きましたが
>番地では無いデータを入力する可能性があり、制限する
と言う事は、仮に XFD15600 とか書いた場合に対象になって良いのかな?

ついでなので 脱線した回答になりますが参考まで
ユーザーフォームを使われていると言う事なので
入力チェックは入力した時に行うのが良いと思います
理由としては、入力時の操作性、処理を分ける事で体感時間の短縮など

ではどうするか・・チェックする処理をサブやファンクションで作成します


Public Function IsRefCheck(strV) As Boolean
Dim rng As Range
'一応 有効範囲設定
Set rng = Range("A1:AX1000")
IsRefCheck = False
If strV = "" Then MsgBox ("空白は使用出来ません適切なセル形式を入力してください"): Exit Function
If Evaluate("ISREF(" & StrConv(strV, vbNarrow) & ")") = False Then MsgBox ("使用出来ない文字列です適切なセル形式を入力してください"): Exit Function
If Not Intersect(rng, Range(strV)) Is Nothing Then
IsRefCheck = True
Else
MsgBox ("範囲内の適切なセル形式を入力してください")
Exit Function
End If
End Function
(空白処理は要考察)

このfunctionを呼ぶイベント
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsRefCheck(TextBox1.Value) = False Then Cancel = True
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsRefCheck(TextBox2.Value) Then Cancel = True
End Sub

実際にはExecutionボタンを条件が揃うまで .Enabled = False などと設定するとか少し工夫します

例 ExecutionはCommandButtonなどのオブジェクト名
Private Sub UserForm_Initialize()
Execution.Enabled = False


End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If IsRefCheck(TextBox1.Value) = False Then
Cancel = True
Else
If TextBox2.Value <> "" Then Execution.Enabled = True
End If
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsRefCheck(TextBox2.Value) Then
Cancel = True
Else
If TextBox1.Value <> "" Then Execution.Enabled = True
End If
End Sub

脱線してしまいましたし、まだ、課題は残ると思いますが・・
参考まで
    • good
    • 0
この回答へのお礼

色々アドバイス頂いてありがとうございます。
Qchan1962さんのコードが難しく感じていまして、中々解読できないでいます。
時間があった際に、頑張って解読してみようと思います。

お礼日時:2022/11/17 12:40

こんにちは



[](Evaluateの短縮形)内では、演算は使えません。
ですので、No2様の回答のようにすれば評価可能になりますね。

別法として、普通にエラー処理を行う方法をご参考までに。

On Error Resume Next
Set r = Union(Range(TextBox1.Value), Range(TextBox2.Value))
If Err.Number <> 0 Then MsgBox "参照エラー": Exit Sub
On Error GoTo 0
この回答への補足あり
    • good
    • 0

正しい文字列を予め決めておくのはダメなのでしょうか。


例えば
英字(1~4桁)+数字(1~5桁)
のようにきめて、上記の条件にマッチする文字であればOKとするとか。
    • good
    • 0

こんにちは


RefEditなんてものもあるけれどModeless不可だったり、そもそも選択するのは仕様が違うのかも・・

[IsRef(TextBox1.Value)] = True
WorksheetFunctionにないようなので 添付図
Evaluateを使って
If Evaluate("ISREF(" & TextBox1.Value & ")") = True And Evaluate("ISREF(" & TextBox2.Value & ")") = True Then
こんな感じでどうでしょう

ORになっているようですけれど、両方Andではないでしょうか?
範囲を制限するロジックは必要ないかな・・
「VBAのユーザーフォームのテキストボッ」の回答画像2
この回答への補足あり
    • good
    • 0

開発タブを有効にして


テキストボックスを挿入して処理すればどうかな
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A