一部マクロを変更したいので教えてください。

質問

現在、下記のようなマクロを使用しています。

Sub sample()
Dim myFile As String, myPath As String, i As Long
Application.ScreenUpdating = False
myPath = InputBox("フルパスでフォルダーを指定")
myFile = Dir(myPath & "\*.xls", vbNormal)
Do
Workbooks.Open myPath & "\" & myFile
For i = 1 To ActiveWorkbook.Sheets.Count
If WorksheetFunction.CountA(Sheets(i).Range("B7:B11")) = 0 Then
Sheets(i).Range("B7") = "*"
End If
Next
ActiveWorkbook.Close True
myFile = Dir()
Loop While myFile <> ""
Application.ScreenUpdating = True
MsgBox "完了 ！！"
End Sub

上から４行目のmyPath = InputBox("フルパスでフォルダーを指定")を
パスを入力するマクロではなくてもっと簡単にフォルダを選択するマクロに変更したいのですが
どうすればいいですか？

回答No.4

merlionXX · ベストアンサー

Sub sample()
Dim myFile As String, myPath As String, i As Long
Dim myObj As Object
Application.ScreenUpdating = False
Set myObj = CreateObject("Shell.Application").BrowseForFolder(0, "フォルダを選択してください", 0)
If myObj Is Nothing Then Exit Sub
myPath = IIf(myObj = "デスクトップ", CreateObject("WScript.Shell").SpecialFolders("Desktop"), myObj.Items.Item.Path)
myFile = Dir(myPath & "\*.xls", vbNormal)
' 以下おなじため略
End Sub

回答No.5

keithin

ん？

sub macro1()
　dim myPath as string
　dim myFile as string
　dim w as worksheet

　With Application.FileDialog(msoFileDialogFolderPicker)
　　If .Show = True Then
　　　application.screenupdating = false
　　　mypath = .selecteditems(1) & "\"
　　　myfile = dir(mypath & "*.xls")
　　　do until myfile = ""
　　　　workbooks.open filename:=mypath & myfile
　　　　for each w in activeworkbook.worksheets
　　　　　if application.counta(w.range("B7:B11"))=0 then
　　　　　　w.range("B7") = "*"
　　　　　end if
　　　　next
　　　　activeworkbook.close savechanges:=true
　　　　myfile = dir()
　　　loop
　　　application.screenupdating = true
　　　msgbox "Done"
　　End If
　End With
End Sub

＃他にも幾つか直してます。
　丸投げしないとできないなら最初からそう言ってください。

回答No.3

qualheart

フォルダ参照を使えば良いと思いますよ。

Dim Shell
Set Shell = CreateObject("Shell.Application")
Set myPath = Shell.BrowseForFolder(&O0, "フォルダを選んでください", &H1 + &H10, "C:\")

キャンセルされた場合など、myPathが空だった場合の処理も必要になります。
If Not myPath Is Nothing Then
～

ご参考まで。

補足

マクロ初心者なので申し訳ないのですが、単純にその行をこれに変更すればよいと
いうわけではないですよね？
できれば、全体を添削していただけないでしょうか？

回答No.2

keithin

＞もっと簡単にフォルダを選択するマクロに変更したい

お好きなやり方をどうぞ：
http://officetanaka.net/excel/vba/tips/tips39.htm

＃結果は簡単ですが,マクロはちょっと簡単じゃありませんね。

回答No.1

kmetu

http://officetanaka.net/excel/vba/file/file02.htm

こちらを参考にしてください。