Макрос заполнения ячеек из выбранного файла - VBA
Формулировка задачи:
Помогите, подскажите что делаю не так? Нужен макрос с выбором файла и заполнением ячеек из этого файла. Но получается что на каждую заполняемую ячейку выходит диалоговое окно выбора файла.
Решение задачи: «Макрос заполнения ячеек из выбранного файла»
textual
Листинг программы
'Option Explicit используется в самом верху модуля.
'Option Explicit заставляет объявлять все переменные и константы.
'Это нужно, чтобы не допускать ошибки в именах переменных и констант.
Option Explicit
Sub Выбор_файла()
'Перед переменными и константами лучше добавлять префикс,
'чтобы имя переменной или константы не совпало с зарезирвированным словом.
'Я добавляю префикс в зависимости от типа данных.
'В данном случае добавил префикс "s".
Dim sFilePath As String
Dim sFileName As String
Dim sFormula As String
sFilePath = GetFilePath
If sFilePath = "" Then Exit Sub
MsgBox sFilePath
'Получаем имя книги.
sFileName = Mid(sFilePath, InStrRev(sFilePath, "\") + 1)
'Получаем путь к книге.
sFilePath = Mid(sFilePath, 1, InStrRev(sFilePath, "\"))
'Формируем общую часть для всех формул.
sFormula = "='" & sFilePath & "[" & sFileName & "]Анализ'!"
Range("D10").FormulaR1C1 = sFormula & "R11C4"
Range("D11").FormulaR1C1 = sFormula & "R12C4"
End Sub
Public Function GetFilePath() As String
Const sTitle As String = "Выберите файл КДРО"
Const sInitialPath As String = "c:\"
Const sFilterDescription As String = "Книги Excel"
Const sFilterExtention As String = "*.xls*"
With Application.FileDialog(msoFileDialogOpen)
.ButtonName = "Выбрать": .Title = sTitle: .InitialFileName = sInitialPath
.Filters.Clear: .Filters.Add sFilterDescription, sFilterExtention
If .Show = 0 Then Exit Function
GetFilePath = .SelectedItems(1)
End With
End Function