|
▼初心者 さん:
こんばんは。
私もフォルダ選択に関しては、INAさんの手法で行っていますが、
それはそれとして・・・・。
Escキーは、Excelでは、特殊なキーになっていますので、
これの処理をいれてみました。
>本日も宜しくお願い致します。
>
>WindowsAPIのSHBrowseForFolderを使用して、
>ダイアログを表示によるフォルダ選択を行う際、
>「Esc」ボタンにてキャンセルするとエラーが発生します。
>しかし、1ステップずつ実行すると、エラーにはなりません。
>
>1.エラーになるパターン
>シート上のコマンドボタンクリック→モジュール呼出「GetFoldName」
>→シート上のセルに取得値セット
>
>2.エラーが発生しないパターン
>シート上のコマンドボタンクリック→ユーザーフォーム(実行ボタンのみ付加)表示
>→ユーザーフォームのボタンクリック→モジュール呼出「GetFoldName」
>ユーザーフォームUnload→シート上のセルに取得値セット
>
>一般的には、シートから直接モジュールを呼び出すというやり方は
>使用されないのでしょうか?
>若しくは、回避策があるのでしょうか?
>
>※機能の検証をしていたので、他の処理は書かれていません。
>
>(シートロジック)
>Private Sub Button_Click()
> Dim FoldName as String
> FoldName = GetFoldName()
>End Sub
>
>(標準モジュール)
>http://homepage1.nifty.com/OkaLab/Program/VbTips01.html#01
>を参照したAPIを標準モジュールに宣言
>
Function GetFoldName() As String
Dim buf As String * 260
Dim buf2 As String * 260
Dim Ret As Long
Dim Operation As BROWSEINFO
Dim sbuf As String
With Operation
.pidlRoot = 0
.hwndOwner = FindWindow("XLMAIN", Application.Caption)
.lpszTitle = ""
.ulFlags = &H3
End With
Application.EnableCancelKey = xlDisabled '*******
Ret = SHBrowseForFolder(Operation) '←デバックではここで黄色になります
If Ret = 0 Then Exit Function
Application.EnableCancelKey = xlInterrupt '*******
sbuf = String$(MAX_PATH, vbNullChar)
SHGetPathFromIDList ByVal Ret, ByVal sbuf
'CoTaskMemFree Ret
GetFoldName = Left(sbuf, InStr(sbuf, vbNullChar) - 1)
If Right(GetFoldName, 1) = "\" Then
GetFoldName = Left(sbuf, InStr(sbuf, vbNullChar) - 2)
End If
End Function
とすると、Escでもエラーは起きませんでした。
>ご存知の方、ご教授の程宜しくお願い致します。
|
|