Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Макрос открытия книги (дополнить)
 
#1
28.03.2011 16:09:15
Приведен код с форума:  
Простите за невежество но мне нужна помощь:  
1. Как дополнить код, чтобы выбранный файл открывался, и из него копировались данные диапазона ячеек, вставлялись на лист книги, содержащий код в определенное место, после чего выбранная книга закрывалась.  
 
Function GetFileName(Optional ByVal Title As String = "Выберите файл для обработки", _  
                    Optional ByVal InitialPath, _  
                    Optional ByVal MyFilter As String = "Книги Excel (*.xls*),") As String  
   ' функция выводит диалоговое окно выбора папки с заголовком Title,  
   ' начиная обзор диска с папки InitialPath  
   ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора  
   If Not IsMissing(InitialPath) Then  
       On Error Resume Next: ChDrive Left(InitialPath, 1)  
       ChDir InitialPath    ' выбираем стартовую папку  
   End If  
   res = Application.GetOpenFilename(MyFilter, , Title, "Открыть")  ' вывод диалогового окна  
   GetFileName = IIf(VarType(res) = vbBoolean, "", res)    ' пустая строка при отказе от выбора  
End Function  
   
Sub ПримерИспользования_GetFileName()  
   ИмяФайла = GetFileName("Заголовок окна", ThisWorkbook.Path)   ' запрашиваем имя файла  
   ' ===================== другие варианты вызова функции =====================  
   ' текстовые файлы, стартовая папка не указана  
   '       ИмяФайла = GetFileName("Выберите текстовый файл", , "Текстовые файлы (*.txt),")  
   ' файлы любого типа из папки "C:\Windows"  
   '       ИмяФайла = GetFileName(, "C:\Windows", "")  
   ' ============================================================­==============  
 
   If ИмяФайла = "" Then Exit Sub    ' выход, если пользователь отказался от выбора файла  
   MsgBox "Выбран файл: " & ИмяФайла, vbInformation  
         
End Sub
 
 
 
#2
28.03.2011 16:32:29
Тут не дополнять надо, а писать макрос "с нуля"...  
 
 
Sub ПримерИспользования_GetFileName()  
   Dim sh As Worksheet: Set sh = ActiveSheet    ' активный лист - на которыый будем вставлять данные  
 
   ИмяФайла = GetFileName("Заголовок окна", ThisWorkbook.Path)    ' запрашиваем имя  
   If ИмяФайла = "" Then Exit Sub    ' выход, если пользователь отказался от выбора файла  
 
   Application.ScreenUpdating = False  
   Dim wb As Workbook: Set wb = Workbooks.Open(ИмяФайла, , True) ' открываем файл  
   wb.Worksheets(1).Range("a2:h8").Copy sh.Range("a1") ' копируем a2:h8 из открытой книги в текущую  
   wb.Close False ' закрываем открытую книгу  
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#3
28.03.2011 16:40:23
Можно проще, но в диалоговом окне выбирайте только одну книгу:  
 
   'пример копирования диапазона A1:B9 открытой книги начиная с ячейки С2 листа,  
   'который был активным перед запуском макроса  
 
Sub OpenCopyClose()  
Dim ash As Worksheet  
Set ash = ActiveSheet  
If Application.Dialogs(xlDialogOpen).Show Then  
   Worksheets(1).[A1:B9].Copy ash.[C2]
   ActiveWorkbook.Close 0  
End If  
End Sub
 
 
 
#4
28.03.2011 16:40:31
Ну например только значения из А1 можно получить, добавив всего 4 строки:  
 
Sub ПримерИспользования_GetFileName()  
ИмяФайла = GetFileName("Заголовок окна", ThisWorkbook.Path) ' запрашиваем имя файла  
' ===================== другие варианты вызова функции =====================  
' текстовые файлы, стартовая папка не указана  
' ИмяФайла = GetFileName("Выберите текстовый файл", , "Текстовые файлы (*.txt),")  
' файлы любого типа из папки "C:\Windows"  
' ИмяФайла = GetFileName(, "C:\Windows", "")  
' ============================================================­==============  
 
If ИмяФайла = "" Then Exit Sub ' выход, если пользователь отказался от выбора файла  
'MsgBox "Выбран файл: " & ИмяФайла, vbInformation  
With GetObject(ИмяФайла)  
ThisWorkbook.Sheets(1).[a1] = .Sheets(1).[a1]
.Close 0  
End With  
End Sub
 
 
 
#5
28.03.2011 16:46:08
Хотя чего это я... Можно и больше, можно и скопировать:  
 
With GetObject(ИмяФайла)  
.Sheets(1).[a1:b10].Copy ThisWorkbook.Sheets(1).[a1]
'ThisWorkbook.Sheets(1).[a1:b10].Value = .Sheets(1).[a1:b10].Value
.Close 0  
End With  
 
Оба варианта.
 
 
 
#6
28.03.2011 17:00:09
Вы как всегда на высоте, пока хотел ответить на письмо от EducatedFool, помогли еще добрые люди. Буду пробовать все варианты всем спасибо.  
Подскажите как осуществить проверку на имя листа в открываемой макросом книге.  
К примеру в исходном файле есть ячейка с названием месяца, в открываемой книге должен быть лист с таким же названием, если лист есть, то копирование происходит из него, если лист не обнаружен, то выпадает Окно с запретом и макрос останавливается.  
Еще раз извините за назойливость.
 
 
 
#7
28.03.2011 17:12:00
{quote}{login=The_Prist}{date=28.03.2011 05:08}{thema=Re: Re: }{post}{quote}{login=}{date=28.03.2011 05:00}{thema=Re: }{post}Подскажите как осуществить проверку на имя листа{/post}{/quote}  
<EM>http://www.excel-vba.ru/index.php?file=Tips_Macro_Sheet_Exist</EM>  
 
А по хорошему для этого вопроса лучше было бы новую тему создать. Но теперь уже не надо :-){/post}{/quote}  
Большое спасибо, решил что новаятема это слишком.
 
 
 
#8
07.04.2011 08:51:46
{quote}{login=EducatedFool}{date=28.03.2011 04:32}{thema=}{post}Тут не дополнять надо, а писать макрос "с нуля"...  
 
 
Sub ПримерИспользования_GetFileName()  
   Dim sh As Worksheet: Set sh = ActiveSheet    ' активный лист - на которыый будем вставлять данные  
 
   ИмяФайла = GetFileName("Заголовок окна", ThisWorkbook.Path)    ' запрашиваем имя  
   If ИмяФайла = "" Then Exit Sub    ' выход, если пользователь отказался от выбора файла  
 
   Application.ScreenUpdating = False  
   Dim wb As Workbook: Set wb = Workbooks.Open(ИмяФайла, , True) ' открываем файл  
   wb.Worksheets(1).Range("a2:h8").Copy sh.Range("a1") ' копируем a2:h8 из открытой книги в текущую  
   wb.Close False ' закрываем открытую книгу  
End Sub{/post}{/quote}  
 
В итоге использовал метод EducatedFool, рабочий инструмент на данной основе получен, теперь пытаюсь уйти от ряда ограничений в использовании.  
1. Подскажите пожалуйста, как  верно записать строку     wb.Worksheets("Потери").Range("a2:h8").Copy sh.Range("a1") - чтобы в ячейку вставлялись только значения формул (эксперименты с макрореком не помогли)  
2. Если не найден лист ("Потери") в открытом файле - то выход из процедуры и надпись по типу  "В указанном файле не найден лист ("Потери")"  
Большое спасибо!
 
 
 
#9
07.04.2011 11:24:41
Эксперименты помогли бы, если записывать не просто вставку, а Специальную вставку - значения. <BR>Про проверку наличия листа: http://yandex.ru/sitesearch?text=%EF%F0%EE%E2%E5%F0%EA%E0+%ED%E0%EB%E8%F7%E8%FF+%EB%E8%F­1%F2%E0&searchid=84804&web=0&lr=22
 
 
 
Страницы: 1
Читают тему
Наверх