Аналог OpenDialog в VBA

← →
ilya39 © (2005-11-10 12:29) [0]

Понадобилось быстро состряпать макрос на VBA, с коим не особо знаком. Подскажите есть может какая функция или свойство какого - либо объекта для вызова диалога открытия файла в VBA?

← →
TUser © (2005-11-10 13:03) [1]

Если FileSystemObject не дает такой возможности, то придется проэкспортировать WinApi функцию CreateDialog и иже с ней.

← →
КаПиБаРа © (2005-11-10 13:12) [2]

Function ExtractFilePath(FileName As String) As String Dim fs, f ExtractFilePath = "" Set fs = CreateObject("Scripting.FileSystemObject") If fs.FileExists(FileName) Then Set f = fs.GetFile(FileName) ExtractFilePath = f.ParentFolder End If Set fs = Nothing Set f = Nothing End Function Function OpenDialog(ATitle As String, AInitFolger As String) As String Dim fs, f OpenDialog = "" Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(AInitFolger) Then Set f = fs.GetFolder(AInitFolger) ChDrive (f.Drive) ChDir (AInitFolger) End If OpenDialog = Application.GetOpenFilename("Excel Files (*.xls), *.xls", , "Подскажите куда спрятали файл?") "получимфайл в который згрузим If Not fs.FileExists(OpenDialog) Then OpenDialog = "" End If Set fs = Nothing Set f = Nothing End Function Function ExistsCustomProperty(AName As String) As Boolean ExistsCustomProperty = False For Each p In ActiveWorkbook.CustomDocumentProperties If p.Name = AName Then ExistsCustomProperty = True End If Next End Function Function OpenDialogExecute(ATitle As String) As String Const LASTDIR As String = "LastDir" If Not ExistsCustomProperty(LASTDIR) Then ActiveWorkbook.CustomDocumentProperties.Add _ Name:=LASTDIR, _ LinkToContent:=False, _ Type:=msoPropertyTypeString, _ Value:=ActiveWorkbook.Path End If OpenDialogExecute = OpenDialog(ATitle, ActiveWorkbook.CustomDocumentProperties(LASTDIR).Value) If OpenDialogExecute <> "" Then ActiveWorkbook.CustomDocumentProperties("LastDir").Value = ExtractFilePath(OpenDialogExecute) End If End Function Private Sub CommandButton2_Click() Dim Myfile1 As String " файл в котором работаем Dim Mypath1 As String " путь к этому файлу Dim Myfile As String " файл в который скачиваем Dim Mypath As String " путь к этому файлу Dim Mylist As String " наименование листа в который переносим информацию Dim Mylist1 As String " наименование листа Dim den As Integer Dim i, j As Integer "переменная цикла Dim bob i = MsgBox("Вы проверили данные?", vbYesNo) If i = 7 Then Exit Sub End If "убераем обновление экрана Application.ScreenUpdating = False Myfile1 = ActiveWorkbook.Name Mypath1 = ActiveWorkbook.Path Mylist1 = ActiveWorkbook.ActiveSheet.Name Myfile = OpenDialogExecute("Подскажите куда спрятали файл?") "получимфайл в который згрузим ...

← →
vertal © (2005-11-10 20:25) [3]

Private Type OpenfileName
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
Flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Declare Function GetSaveFileNameA Lib "comdlg32.dll" (pOpenfilename As OpenfileName) As Long
Private Declare Function GetOpenFileNameA Lib "comdlg32.dll" (pOpenfilename As OpenfileName) As Long
Private Declare Function ChooseColorA Lib "comdlg32.dll" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long

Public Function OpenFileDialog(Optional ByVal Types As String, Optional Title As String, Optional InitialDir As String, Optional DefaultExt As String) As String
"Подпрограмма: OpenFileDialog
"Что делает: Показывает стандартный диалог открытия файла с заданными
"параметрами
"Параметры:
"[Types] — строка фильтров, где каждому фильтру соответствует пара строк
"описание-маска, разделённых символом с кодом 0 — vbNullChar.
"Сами эти пары, в свою очередь, также отделены vbNullChar,
"в конце идёт два vbNullChar подряд.
"Фильтр — это выбранная строка в combobox под основным полем
"диалога («Все файлы (*.*)», «Файлы рисунков (*.BMP)» и пр.)
"Если параметр не задан или равен 0, используется фильтр «Все файлы (*.*)».
"[Title] — заголовок диалога. Если не задан, используется «Открытие файла».
"[InitialDir] — каталог, открывающийся при появлении диалога. Не задан — текущий.
"[DefaultExt] — расширение, присоединяемое к файлу, если пользователь
"набирал имя файла в поле ввода «Имя файла» и не указал расширение.
"Рекомендуется указать — опыт показал, что при указанном параметре
"и установленном фильтре, отличном от «Все файлы», набор
"имени файла приводит к установке расширения, определяемого фильтром,
"даже когда он (фильтр) не совпадает с DefaultExt. Это наиболее
"разумное поведение диалога по отношению к пользователю.
"Возвращает: полное имя (с путём) выбранного файла
"Программист: Каньковски Пётр
"Комментарии: ф-ция даёт доступ далеко не ко всем возможностям
"диалога Windows, но её вполне достаточно для большинства задач.
"Не поддерживаются: пользовательские фильтры (используются
"крайне редко), выделение нескольких файлов, внедрение своих
"элементов управления в стандартные диалоги.
"Если пользователь нажал «Отмена», функция возвратит пустую строку.
"Связи: AllTypes, OpenfileName, GetOpenFileNameA, GetActiveWindow
"Примеры:
"OpenFileDialog("Файлы рисунков (*.BMP)" + vbNullChar + "*.bmp" + vbNullChar+ _
" "Все файлы (*.*)" + vbNullChar + "*.*" + vbNullChar + vbNullChar, _
" "Выберите рисунок для вставки", "C:\", "bmp")
Dim OFN As OpenfileName
On Error GoTo 1
If Len(Types) = 0 Then Types = ConstructType("*", "All files")
With OFN
.lpstrFilter = Types ": OFN.nFilterIndex = 2 — чтобы установить не первый фильтр при открытии диалога
.lpstrFile = String$(500, vbNullChar)
.nMaxFile = 500
.Flags = &H1804 "Файл и путь должны существовать, спрятать флажок ReadOnly
.lpstrTitle = Title
.lpstrInitialDir = InitialDir
.lpstrDefExt = DefaultExt
.hwndOwner = GetActiveWindow
.lStructSize = LenB(OFN)
If GetOpenFileNameA(OFN) Then OpenFileDialog = IIf(InStr(.lpstrFile, vbNullChar), Left(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1), .lpstrFile)
End With
Exit Function
1: MsgBox Err.Description, vbCritical, "OpenFileDialog: unexpected error!"
End Function

← →
ilya39 © (2005-11-11 12:29) [4]

Всем спасибо конечно, но мне больше понравилось использовать Microsoft Common Dialog Control...

ilya39 © (11.11.05 12:29) [4]
Microsoft Common Dialog Control.
Это хто такая?

Опубликуй в каких позах ты ее использовал :)

Это в Additional Controls. Живет она в comdlg32.ocx Использовал по назначению :)

Аналог OpenDialog в VBA Найти похожие ветки