【VBA】InputBoxで文字をセルに入力する時に・・・

Question

VBA初心者です。　業務で使用する為、ほぼ全てネット上のコピペでなんとかしようとしてきましたが、知識不足で応用が利かず困り果てております。

VBAを使ってやりたい事↓
1.　フォルダパスを指定して、フォルダの中身を検索し、エクセルを開く

2.　どのセルに入力するのかをInputBoxに入力する（セルを選択して指定する？とか・・）

3.　更にInputBoxが表示され、2.で指定したセルに入力したい文字を入れる

4.　「追加しますがよろしいですか？」に対してOKを選ぶと、全てのファイルの指定したセルに指定した文字が入力され、保存して閉じる


上記の様な事が目的で、以下の様なコードを用意しましたが、目的の2.を達成するための文章がわかりません。

Set rng = Application.InputBox("セルを選択して下さい", Type:=8)

という文章を入れて選択出来るところまでは来ています。
最後のFileProcessのところに何か文章入れれば良いと思うのですが、どの様な文章を入れれば良いでしょうか。

明日までに何とかしなければなりません・・・
どなたか宜しくお願い致します。


Option Explicit
    Private strToInput As String

Sub StartProgram_文字入力するやつ()
     Dim filepath As Variant
     Dim ans As String
     Dim wb As Workbook
     Dim msg As String
     Dim rng As Range
     
     filepath = InputBox("文字を反映させるフォルダのパスを入力してください" & vbCrLf & "(例) C:\Users\Somewhere", "ターゲットフォルダの指定")
     If filepath = "" Then Exit Sub
     
     Set rng = Application.InputBox("セルを選択して下さい", Type:=8)
     If rng = vbCancel Then Exit Sub
     
     strToInput = InputBox("反映させる文字を入力して下さい" & vbCrLf & "(例) 〇〇〇〇", "文字の入力")
     If strToInput = "" Then Exit Sub
     
     msg = MsgBox(filepath & vbCrLf & vbCrLf & "上記フォルダ内に" & "  " & "〇〇〇" & "  " & strToInput & "  " & "を追加しますがよろしいですか？", vbYesNo + vbQuestion)
     If msg = vbNo Then Exit Sub
     
     Dim fso As Object
     Dim fld As Object
     Set fso = CreateObject("Scripting.FileSystemObject")
 
     Set fld = fso.GetFolder(filepath)
 
     FolderProcess fld
     
 End Sub
 
 
 Sub FolderProcess(ByVal fld As Object)
 
     
     Dim childFld As Object
 
     For Each childFld In fld.SubFolders
         FolderProcess childFld
     Next
 
    Dim xlsfileRe As Object
    Dim childFile As Object
    Dim mths As Object
    Set xlsfileRe = CreateObject("VBScript.RegExp")
    xlsfileRe.Pattern = ".xl"
    xlsfileRe.IgnoreCase = True

    For Each childFile In fld.Files
        Set mths = xlsfileRe.Execute(childFile.Name)
        
        If mths.Count > 0 Then FileProcess childFile
    Next
End Sub

Sub FileProcess(ByVal f As File)
    Dim wb As Workbook
    Dim ans As String
    Dim rng As Range
    
    Set wb = Application.Workbooks.Open(f.Path)
    
    

    Application.DisplayAlerts = False
    wb.Save
    wb.Close

    Application.DisplayAlerts = True
    
End Sub

Qchan1962 · Accepted Answer

サンプル書いてみましたので試してみてください。
正規表現での処理部分、fso使っているのでGetExtensionNameに変えてしまいました。
VBScript.RegExpにこだわりがあるようなら戻してください。

VBAを実行するとmsoFileDialogFolderPickerが表示され、フォルダを選択すると
そのフォルダ内にあるブックが開きます。
開いた後にApplication.InputBox("セルを選択して下さい", Type:=8)が表示され
開かれているブックでセルを選択してください。（チェックリストシートがアクティブになります）
OKを押すと開いているブックは閉じられ、
入力文字の入力InputBox、確認メッセージが表示され、フォルダ内（サブフォルダを含む）のファイルに
書き込み処理がされます。

Option Explicit
Dim n As Long
Dim TargetFile()
Sub StartProgram_文字入力するやつ()
Dim wb As Workbook, rng As Range
Dim i As Long
Dim filepath As String, strRng As String
Dim strToInput As String, msg As String
Dim FSO As New FileSystemObject
Dim objFile As File

With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "文字を反映させるフォルダを選択してください"
　　　　If .Show = True Then
　　　　　　filepath = .SelectedItems(1)
　　　　End If
　　End With
　　If filepath = "" Then Exit Sub
　　On Error Resume Next
　　For Each objFile In FSO.GetFolder(filepath).Files
　　　　If StrConv(FSO.GetExtensionName(objFile.Name), 2) Like "xl*" Then
　　　　　　Set wb = Workbooks.Open(objFile.Path)
　　　　　　ActiveWorkbook.Sheets("チェックリスト").Activate
　　　　　　Exit For
　　　　End If
　　Next
　　Set rng = Application.InputBox("セルを選択して下さい", Type:=8)
　　If rng Is Nothing Then Exit Sub
　　strRng = rng.Address
　　wb.Close
　　Set rng = Nothing
　　strToInput = InputBox("反映させる文字を入力して下さい" & vbCrLf & "(例) 〇〇〇〇", "文字の入力")
　　If strToInput = "" Then Exit Sub
　　msg = MsgBox(filepath & vbCrLf & vbCrLf & _
　　　　　　　　 "上記フォルダ内に" & " " & "〇〇〇" & " " & strToInput & " " & "を追加しますがよろしいですか？", vbYesNo + vbQuestion)
　　If msg = vbNo Then Exit Sub
　　n = 0
　　Call getFileList(filepath)
　　Application.ScreenUpdating = False
　　Application.DisplayAlerts = False
　　For i = 0 To UBound(TargetFile)
　　　　With Application.Workbooks.Open(TargetFile(i))
　　　　　　.Sheets("チェックリスト").Range(strRng).Value = strToInput
　　　　　　.Save
　　　　　　.Close
　　　　End With
　　Next
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
　　MsgBox ("完了しました")
End Sub
Sub getFileList(filepath)
Dim FSO As New FileSystemObject
Dim objFol As Folder, objFile As File
　　For Each objFol In FSO.GetFolder(filepath).SubFolders
　　　　Call getFileList(objFol.Path)
　　Next
　　For Each objFile In FSO.GetFolder(filepath).Files
　　　　If StrConv(FSO.GetExtensionName(objFile.Name), 2) Like "xl*" Then
　　　　　　ReDim Preserve TargetFile(n)
　　　　　　TargetFile(n) = objFile.Path
　　　　　　n = n + 1
　　　　End If
　　Next
End Sub

期待する結果が出ない場合、On Error Resume Nextをコメントにしてエラーを確認してください。

nekoronda · Answer

FileProcess　なんてコード上にありませんが？？

nekoronda · Answer

失礼しました。私が見落としておりました。そちらに非はありません。
「何か文章」とはオープン処理をした後のコードを指しているんだと思うんですけど、
素直に”StartProgram_文字入力するやつ”で取得したrng とstrToInput を変数として、
渡してあげれば良いだけでは？

あと、rngがRange型になっていますが、inputboxの戻りはString型です。

Qchan1962 · Answer

こんばんは、
書き出すシートを指定しなくて良いのでしょうか？
また、Set rng = Application.InputBox("セルを選択して下さい", Type:=8)は、実行している
レンジをセットしているのですが、対象（開いて書き込む）のセルアドレスと理解して良いのでしょうか？
その場合、rng.Addressとして書き込みレンジで使用します。（ThisWorkbookでないので）

示されているコードを追加しました。細かいところは検討していません。

Option Explicit
Private strToInput As String
Sub StartProgram_文字入力するやつ()
Dim filepath As Variant
Dim ans As String
Dim wb As Workbook
Dim msg As String
Dim rng As Range
Dim fso As Object
Dim fld As Object
　　filepath = InputBox("文字を反映させるフォルダのパスを入力してください" & vbCrLf & "(例) C:\Users\Somewhere", "ターゲットフォルダの指定")
　　If filepath = "" Then Exit Sub
　　Set rng = Application.InputBox("セルを選択して下さい", Type:=8)
　　If rng = vbCancel Then Exit Sub
　　strToInput = InputBox("反映させる文字を入力して下さい" & vbCrLf & "(例) 〇〇〇〇", "文字の入力")
　　If strToInput = "" Then Exit Sub
　　msg = MsgBox(filepath & vbCrLf & vbCrLf & "上記フォルダ内に" & " " & "〇〇〇" & " " & strToInput & " " & "を追加しますがよろしいですか？", vbYesNo + vbQuestion)
　　If msg = vbNo Then Exit Sub
　　Set fso = CreateObject("Scripting.FileSystemObject")
　　Set fld = fso.GetFolder(filepath)

FolderProcess fld, rng, strToInput

End Sub

Sub FolderProcess(ByVal fld As Object, rng As Range, strToInput As String)
Dim childFld As Object, xlsfileRe As Object
Dim childFile As Object, mths As Object

For Each childFld In fld.SubFolders
　　　　FolderProcess childFld, rng, strToInput
　　Next

Set xlsfileRe = CreateObject("VBScript.RegExp")
　　xlsfileRe.Pattern = ".xl"
　　xlsfileRe.IgnoreCase = True

For Each childFile In fld.Files
　　　　Set mths = xlsfileRe.Execute(childFile.Name)
　　　　If mths.Count > 0 Then FileProcess childFile, rng, strToInput
　　Next
End Sub

Sub FileProcess(ByVal f As File, rng As Range, strToInput As String)
Dim wb As Workbook

Set wb = Application.Workbooks.Open(f.Path)

wb.Sheets(1).Range(rng.Address).Value = strToInput　'インデックス1のシートに対して

Application.DisplayAlerts = False
　　wb.Save
　　wb.Close
　　Application.DisplayAlerts = True

End Sub

Qchan1962 · Answer

検証して少し気になりました。
＞Set rng = Application.InputBox("セルを選択して下さい", Type:=8)
＞If rng = vbCancel Then Exit Sub

複数選択セルでエラーが吐かれました。
他にもfilepath = InputBoxでタイプミスや存在しないパスを打ってしまったり、色々考えなくてはいけないかも知れません。

まあ、ここだけを見た場合、
    On Error Resume Next
    Set rng = Application.InputBox("セルを選択して下さい", Type:=8)
    If rng = "" Then Exit Sub
のような対策をした方が良いかと（単セルのみの書き込みならいらないのかな？）

Qchan1962 · Answer

＃４です。連投すみません。
間違ったことを伝えました。
If rng = "" Then Exit Sub　　×
Rangeなので
If rng Is Nothing Then Exit Sub　です。すみません。

ついでなので、
filepath = InputBox("文字を反映させるフォルダのパスを入力してください" & vbCrLf & "(例) C:\Users\Somewhere", "ターゲットフォルダの指定")
入力ミスなどにより、後のエラーも考えられるのでFolderPickerを使った方が良いと思います。

filepath = InputBox("文字を反映させるフォルダのパスを入力してください" & vbCrLf & "(例) C:\Users\Somewhere", "ターゲットフォルダの指定")
If filepath = "" Then Exit Sub
を

With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "文字を反映させるフォルダを選択してください"
　　　　If .Show = True Then
　　　　　　filepath = .SelectedItems(1)
　　　　End If
　　End With
　　If filepath = "" Then Exit Sub

これで、filepathには存在するフォルダパスが代入されます。

Qchan1962 · Answer

rngは

Dim rng As Range　で
Set rng = Application.InputBox("セルを選択して下さい", Type:=8)
になっていますか。変更していませんか？

Sub FolderProcess(ByVal fld As Object, rng As Range, strToInput As String)
Sub FileProcess(ByVal f As File, rng As Range, strToInput As String)
rng As Rangeで引数を渡していますか、、

エラー行にブレイクポイントを設定してイミディエイトウィンドウで各値を確認してみてください。
エラー行の1行上に
Debug.Print wb.Name; "><"; wb.Sheets.Name; "><"; rng.Address; "><"; strToInput

多分、rng.Addressの値が入っていないなどでは無いかと思います。

シートの特定は、どうされるのでしょうか？
対象のファイルには、1シートしかないのでしょうか？これが引っかかっています。

本当にごめんなさい。ご質問のコードで回答しなくてはいけないのかも知れませんが、
再帰処理のところなど　書き直したものを下記に示します。
プロセスを変更しました。

各設定をFolderPicker、Application.InputBox、InputBox　で設定
親フォルダおよびサブフォルダ内にあるlxファイルのフルパスおよびファイル名を配列に格納
配列内のデータに基づきターゲットを開きメイン処理を行って保存して閉じる

実行結果は、同じになると思います。
良かったら、こちらも試してください。

モジュール変数を使っていますので、標準モジュールを追加してコードをコピペ
テストは、親フォルダ、サブフォルダ、ファイル数　共に最小単位で

Option Explicit
Dim n As Long
Dim TargetFile()
Sub StartProgram_文字入力するやつ()
Dim i As Long, filepath As String
Dim strToInput As String, msg As String
Dim rng As Range
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "文字を反映させるフォルダを選択してください"
　　　　If .Show = True Then
　　　　　　filepath = .SelectedItems(1)
　　　　End If
　　End With
　　If filepath = "" Then Exit Sub
　　On Error Resume Next
　　Set rng = Application.InputBox("セルを選択して下さい", Type:=8)
　　If rng Is Nothing Then Exit Sub
　　strToInput = InputBox("反映させる文字を入力して下さい" & vbCrLf & "(例) 〇〇〇〇", "文字の入力")
　　If strToInput = "" Then Exit Sub
　　msg = MsgBox(filepath & vbCrLf & vbCrLf & _
　　　　　　　　 "上記フォルダ内に" & " " & "〇〇〇" & " " & strToInput & " " & "を追加しますがよろしいですか？", vbYesNo + vbQuestion)
　　If msg = vbNo Then Exit Sub
　　n = 0
　　Call getFileList(filepath)
　　Application.ScreenUpdating = False
　　Application.DisplayAlerts = False
　　For i = 0 To UBound(TargetFile)
　　　　With Application.Workbooks.Open(TargetFile(i))
　　　　　　.Sheets(1).Range(rng.Address).Value = strToInput
　　　　　　.Save
　　　　　　.Close
　　　　End With
　　Next
　　Application.DisplayAlerts = True
　　Application.ScreenUpdating = True
End Sub
Sub getFileList(filepath)
Dim FSO As New FileSystemObject
Dim objFol As Folder, objFile As File
Dim xlsfileRe As Object, mths As Object
　　For Each objFol In FSO.GetFolder(filepath).SubFolders
　　　　Call getFileList(objFol.Path)
　　Next
　　Set xlsfileRe = CreateObject("VBScript.RegExp")
　　xlsfileRe.Pattern = ".xl"
　　xlsfileRe.IgnoreCase = True
　　For Each objFile In FSO.GetFolder(filepath).Files
　　　　Set mths = xlsfileRe.Execute(objFile.Name)
　　　　If mths.Count > 0 Then
　　　　　　ReDim Preserve TargetFile(n)
　　　　　　TargetFile(n) = objFile.Path
　　　　　　n = n + 1
　　　　End If
　　Next
End Sub

Qchan1962 · Answer

こんばんは、一度投稿に失敗しました。
＞wb.Sheets.Name この部分で「メソッドまたはテータメンバーが見つかりません。」と出てきます。
すみません。これは、間違いです。wb.Sheets(1).Name　とするべきでした。

また仰る通り、「rng.Address」で<オブジェクトが必要です>と表示されます。
Set rngでセットされた値がどこかでリセットされています。rngを追ってみればわかると思います。

＞状況としましては、開けるフォルダが１つで、フォルダ内の一番上に来ているエクセルファイルにのみ処理がなされました。

ローカルにテスト環境を作り検証しましたが、同様の事象は発生しませんでした。

まず、コード内の　On Error Resume Next　をコメントブロックして　エラーを確認してみてください。

実行時エラー　9　なら　該当シートが見つからない可能性があります。
また、対象のフォルダ内に自ブックがある場合もエラーが発生します。（すでに開かれている）
さらに、対象シートに保護が設定されている場合もエラーが返されると思いますね。

1つだけが気になるので
　　　　With Application.Workbooks.Open(TargetFile(i))
　　　　　　.Sheets(1).Range(rng.Address).Value = strToInput
　　　　　　.Save
　　　　　　.Close
　　　　End With
をコメントブロックして

Sheets(1).cells(1+i,1)=TargetFile(i)

を入れ実行してみてください。一番左のシートのA列に対象のファイル情報が出力されると思います。
一番左のシートは、書き込まれても良いようにしてくださいね。

すべてのファイル情報が出力されれば、問題は、シートオブジェクトの指定とアドレスと言う事になります。
しかし、思ったところに1回は出力されているのでセルのアドレスの可能性はなくなります。

取り敢えず、ちょっと検証してみてくださいね。

Qchan1962 · Answer

こんばんは、
＞この場合、編集したいエクセルのセルを指定したあとに、その指定したセルのあるエクセルを閉じてから処理を開始するという動作をさせる事は可能でしょうか。
出来ます。
＞実際に編集したい箇所を見ながら指定したかった為、
もう1つブックを開いていると言う事でしょうか？それとも Application.FileDialog(msoFileDialogFolderPicker)で
フォルダを指定した時に一番初めのブックを開いて表示させ、そのブックでセルの位置を確認しながら指定して、、実行と言う流れでしょうか？

色々明確にする必要があるかと思いますが、現在のコードだとSet rng = Application.InputBox("セルを選択して下さい", Type:=8)で
Setした値には、オブジェクトが含まれていると思いますので、選択したブックを閉じるとエラーが返されるはずです。
なので、Set rng = Application.InputBox("セルを選択して下さい", Type:=8)　した後ですぐに
strRng=rng.Address

strRngは、String型変数です。　strRngに代入する必要が出てくるかと思います。
それに伴い.Sheets(1).Range(rng.Address).Value = strToInput　は
.Sheets(1).Range(strRng).Value = strToInput　となります。

セルを選択する前後のプロセスを教えてください。

①初めから開いておく（この場合、特定するためにブック名または特定シートのセルの値などが必要になります
マクロ実行ブックと対象のブックのみ開いているなら特定できますが、バグ含みになります）

②フォルダを指定した時に一番初めのブックを開いて表示させそのブックのセルを選択する。

選択後は、閉じてまとめて開き編集、閉じる。（比較的簡単）
選択後は、閉じずに分岐処理で対応する（ちょっと面倒）

【VBA】InputBoxで文字をセルに入力する時に・・・

FileProcess なんてコード上にありませんが？？

失礼しました。

こんばんは、

検証して少し気になりました。

＃４です。

rngは

こんばんは、一度投稿に失敗しました。

こんばんは、

サンプル書いてみましたので試してみてください。

似たような質問が見つかりました

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

関連するカテゴリからQ&Aを探す

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

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

FileProcess　なんてコード上にありませんが？？