Форум программистов
 
Контакты: о проблемах с регистрацией, почтой и по другим вопросам пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail


Донат для форума - использовать для поднятия настроения себе и модераторам

А ещё здесь можно купить рекламу за 25 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru

Ответ
 
Опции темы
Старый 27.06.2012, 15:15   #1
ольгаг
Форумчанин
 
Регистрация: 22.02.2010
Сообщений: 320
Репутация: 21
По умолчанию Таблицы Access в Листы Excel дописать код

Здравствуйте Уважаемые программисты!
Есть файл-база с таблицами в Access (например, Таблица1, Таблица2 и т.д.).
Код приведенный ниже (находится в активной книге Excel) позволяет из файла Access в активную книгу Excel импортировать данные этих таблиц
предварительно создав Листы Excel с именами равными именам таблиц Access.

Private Sub Workbook_Open()

Dim Database As DAO.Database
Dim rs As DAO.Recordset
Dim Filename As String
Dim tb As DAO.TableDef
Dim Sheet As Worksheet
Dim wkbk As Excel.Workbook
Dim wksht As String
Dim i As Integer
Dim xl As New Excel.Application

Filename = "БазаДанных.mdb"
If Dir(ThisWorkbook.Path & "\" & Filename) <> "" Then
Set Database = DAO.OpenDatabase(ThisWorkbook.Path & "\" & Filename, True, True)
End If

xl.DisplayAlerts = False
With wkbk
For Each tb In Database.TableDefs
If Left(tb.Name, 4) <> "MSys" Then
Set rs = Database.OpenRecordset(tb.Name, dbOpenDynaset)
wksht = tb.Name
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = wksht
Sheets(wksht).Range("A1").CopyFromR ecordset rs
End If
Next tb
End With
xl.DisplayAlerts = True
rs.Close
xl.Quit
Set wkbk = Nothing
Set xl = Nothing
Set rs = Nothing
Set Database = Nothing

End Sub

Подскажите пожалуйста, как добавить в данный код проверку совпадения имен существующих в книге Листов с именами выгружаемых таблиц Access, т.е. если в активной книге Excel существует Лист и он совпадает по своему имени с именем любой таблицы Access, то новый лист (с именем таблицы Access) не создавать.
Заранее спасибо.
ольгаг вне форума   Ответить с цитированием
Старый 27.06.2012, 15:28   #2
Казанский
Профессионал
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
Репутация: 938
По умолчанию

Этот кусок
Код:
wksht = tb.Name
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = wksht
Sheets(wksht).Range("A1").CopyFromRecordset rs
надо изменить так:
Код:
wksht = tb.Name
On Error Resume Next
Set Sheet = Sheets(wksht)
If Err Then 'лист не существует
    Err.Clear
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = wksht
    Sheets(wksht).Range("A1").CopyFromRecordset rs
Else        'лист существует
    'какие-то действия с Sheet
End If
__________________
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума   Ответить с цитированием
Старый 27.06.2012, 19:39   #3
ольгаг
Форумчанин
 
Регистрация: 22.02.2010
Сообщений: 320
Репутация: 21
По умолчанию

Цитата:
Сообщение от Казанский Посмотреть сообщение
Этот кусок
Код:
wksht = tb.Name
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = wksht
Sheets(wksht).Range("A1").CopyFromRecordset rs
надо изменить так:
Код:
wksht = tb.Name
On Error Resume Next
Set Sheet = Sheets(wksht)
If Err Then 'лист не существует
    Err.Clear
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = wksht
    Sheets(wksht).Range("A1").CopyFromRecordset rs
Else        'лист существует
    'какие-то действия с Sheet
End If
Спасибо за код, я попробую.
Подскажите пожалуйста, как исправить появление ошибки "Error in loading dll" в строке:
For Each tb In Database.TableDefs?
ольгаг вне форума   Ответить с цитированием
Старый 27.06.2012, 21:24   #4
ольгаг
Форумчанин
 
Регистрация: 22.02.2010
Сообщений: 320
Репутация: 21
По умолчанию

Цитата:
Сообщение от Казанский Посмотреть сообщение
Этот кусок
Код:
wksht = tb.Name
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = wksht
Sheets(wksht).Range("A1").CopyFromRecordset rs
надо изменить так:
Код:
wksht = tb.Name
On Error Resume Next
Set Sheet = Sheets(wksht)
If Err Then 'лист не существует
    Err.Clear
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = wksht
    Sheets(wksht).Range("A1").CopyFromRecordset rs
Else        'лист существует
    'какие-то действия с Sheet
End If
Я попробовала изменить код как Вы сказали (только изменила If Err на If Not Err - иначе листы не создавались, даже если их не было в книге). В итоге вылетает сообщение что лист с таким именем существует и создается новый пустой лист.
ольгаг вне форума   Ответить с цитированием
Старый 27.06.2012, 22:24   #5
Казанский
Профессионал
 
Аватар для Казанский
 
Регистрация: 31.12.2010
Сообщений: 2,133
Репутация: 938
По умолчанию

> Я попробовала изменить код как Вы сказали (только изменила If Err на If Not Err ...

Супер! Теперь условие выполняется ВСЕГДА (долго объяснять, почему).
Может, есть СКРЫТЫЕ листы с такими именами?
__________________
exceleved@yandex.ru Яндекс.Деньги: 410011500007619
Казанский вне форума   Ответить с цитированием
Старый 28.06.2012, 07:21   #6
ольгаг
Форумчанин
 
Регистрация: 22.02.2010
Сообщений: 320
Репутация: 21
По умолчанию

Цитата:
Сообщение от Казанский Посмотреть сообщение
> Я попробовала изменить код как Вы сказали (только изменила If Err на If Not Err ...

Супер! Теперь условие выполняется ВСЕГДА (долго объяснять, почему).
Может, есть СКРЫТЫЕ листы с такими именами?
Скрытых листов нет.
Код работает и добавляет Листы с именами таблиц Access, но если такие Листы уже есть в книге Excel, то повторно они не должны добавляться - это
пока у меня не получается сделать.
ольгаг вне форума   Ответить с цитированием
Старый 28.06.2012, 07:44   #7
ольгаг
Форумчанин
 
Регистрация: 22.02.2010
Сообщений: 320
Репутация: 21
По умолчанию

Цитата:
Сообщение от Казанский Посмотреть сообщение
Этот кусок
Код:
wksht = tb.Name
Sheets.Add after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = wksht
Sheets(wksht).Range("A1").CopyFromRecordset rs
надо изменить так:
Код:
wksht = tb.Name
On Error Resume Next
Set Sheet = Sheets(wksht)
If Err Then 'лист не существует
    Err.Clear
    Sheets.Add after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = wksht
    Sheets(wksht).Range("A1").CopyFromRecordset rs
Else        'лист существует
    'какие-то действия с Sheet
End If
Прошу прощения. При данном изменении макрос работает как надо!
Я попробовала на другом компьютере - все работает.
Пока не знаю почему не работает на моем компьютере.
Спасибо!
ольгаг вне форума   Ответить с цитированием
Ответ

Опции темы

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.

Быстрый переход

Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
из таблицы access в лист excel alexandrsurgut Microsoft Office Access 1 15.02.2012 04:02
Из таблицы access создать лист Excel ольгаг Microsoft Office Excel 6 01.02.2012 13:20
Таблицы StringGrid в разные листы Excel Marina8 Общие вопросы Delphi 4 21.12.2011 17:58
Импорт таблицы из Access в Excel Callika Microsoft Office Excel 6 17.03.2011 23:10


01:46.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.