Консультация № 115170
21.12.2007, 08:57
0.00 руб.
0 2 2
Уважаемые эксперты Вопрос
1)как из макроса в Excel открыть окно для выбора файла и выбрать его
2) Файл имеет расширение типа .001 а мне надо открыть его при помощи Excel.
Спасибо

Обсуждение

Неизвестный
21.12.2007, 09:17
общий
это ответ
Здравствуйте, Larsh!
Используйте FileDialog.Filters:
<code>
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
With .Filters
.Clear
.Add "Файл 001", "*.001", 1
.Add "Все Файлы", "*.*", 2
End With
If .Show = -1 Then
‘делайте с файлом что хотите
MsgBox .SelectedItems(1)
End If
End With
</code>
Успехов.
Неизвестный
21.12.2007, 19:52
общий
это ответ
Здравствуйте, Larsh!
Создайте кнопку на любом листе Excel и впишите туда этот код:

Option Explicit
Dim Res1 As Boolean
Dim Dir1 As String, ОдинСимвол As String
Dim Flname As String
Dim Flt1 As String

Private Sub CommandButton1_Click()
Res1 = MyGetFileName(Dir1, Flname, Application.Hwnd)
If Not Res1 Then MsgBox "Файл не выбран, программа завершает работу.", , "Отказ от выбора файла"
End Sub

Затем создайте модуль и впишите туда этот код:
Option Explicit
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 Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Function MyGetFileName(DirStr As String, FileNameStr As String, Optional hwndOwnerArg As Long = 0) As Boolean
Dim pOpenfilename As OPENFILENAME
Dim n As Integer, i As Integer, X As Long, St1 As String, St2 As String, St3 As String
pOpenfilename.lStructSize = Len(pOpenfilename)
pOpenfilename.hwndOwner = hwndOwnerArg
pOpenfilename.lpstrTitle = "Выберите нужный файл"
St1 = "Все файлы" & vbNullChar & "*.*"
pOpenfilename.lpstrInitialDir = DirStr
pOpenfilename.lpstrFilter = St1
pOpenfilename.lpstrFile = LPBuff(512)
pOpenfilename.nMaxFile = 511
pOpenfilename.lpstrFileTitle = LPBuff(512)
pOpenfilename.nMaxFileTitle = 511
pOpenfilename.flags = 16384 Or 2097152 Or 1048576 Or 524288
pOpenfilename.flags = pOpenfilename.flags Or 512
X = GetOpenFileName(pOpenfilename)
If X = 1 Then
MyGetFileName = True
St1 = LP2VB2(pOpenfilename.lpstrFile)
DirStr = Left(St1, pOpenfilename.nFileOffset - 1)
n = -1
St2 = St1
Do
St3 = MyGetLpStr(St2)
n = n + 1
Loop Until St2 = ""
If n >= 1 Then
MsgBox "Выбрано несколько файлов! Программа завершает работу"
End
Else
FileNameStr = Right$(St1, Len(St1) - pOpenfilename.nFileOffset)
End If
Else
MyGetFileName = False
DirStr = ""
FileNameStr = ""
End If
End Function
Private Function LP2VB2(St1) As String
LP2VB2 = Left$(St1, InStr(1, St1, vbNullChar & vbNullChar) - 1) ‘здесь формируется полный путь и имя файла
End Function

Private Function LPBuff(n As Integer) As String
LPBuff = String(n, vbNullChar)
End Function
Public Function MyGetDirStr(Str1 As String) As String
Dim i As Integer, i1 As Integer, k As Integer
Dim St1 As String
If Len(Str1) > 0 Then
k = 1
Do
i = InStr(k, Str1, "")
If i <> 0 Then i1 = i: k = i + 1
Loop While i <> 0
If i1 <> 0 Then
St1 = Left$(Str1, i1)
Else
i = InStr(1, Str1, ":")
If i = 0 Then
St1 = ""
Else
St1 = Left$(Str1, i1) & ""
End If
End If
Else
St1 = ""
End If
MyGetDirStr = St1
End Function
Private Function MyGetLpStr(St1 As String) As String
Dim i As Variant
i = InStr(1, St1, vbNullChar)
If IsNull(i) Then
MyGetLpStr = ""
St1 = ""
Exit Function
ElseIf i = 0 Then
MyGetLpStr = St1
St1 = ""
Exit Function
Else
MyGetLpStr = Left$(St1, i - 1)
St1 = Right$(St1, Len(St1) - i)
Exit Function
End If
End Function
Public Function NormalizeDir(Str1 As String) As String
If Len(Str1) = 0 Then
NormalizeDir = ""
Exit Function
Else
If Right$(Str1, 1) <> "" Then
NormalizeDir = Str1 & ""
Exit Function
Else
NormalizeDir = Str1
Exit Function
End If
End If
End Function

Приятной работы!
Форма ответа