Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

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

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 26.06.2017, 16:31   #1
Ethex
Пользователь
 
Регистрация: 26.04.2017
Сообщений: 86
По умолчанию VBA Access Обращение к списку имён таблиц

Доброго времени суток
Моя задача - сделать программу экспорта из акса в эксель. Требуется экспортировать несколько (в данный момент 5) таблиц в одну книгу на разные листы. Имеется код теоретически нужный код, который пока не проверял

Код:
Sub CopyToExcel(tblName)    'Процедура экспорта в Excel
'tblName - массив содержащий имена таблиц
    Dim db As DAO.Database, rst As DAO.Recordset, i, t, j&
    Dim app As Object, wrk As Object
    Set db = CurrentDb
 
    Set app = CreateObject("excel.application")
    Set wrk = app.workbooks.Add
    For i = 0 To UBound(tblName)
        t = tblName(i)
        If i <= wrk.sheets.Count - 1 Then
            wrk.sheets(i + 1).Name = t
        Else
            wrk.sheets.Add(, wrk.sheets(i)).Name = t
        End If
        Set rst = db.OpenRecordset("select * from [" & t & "]")
        app.sheets(t).Activate
        app.range("a2").copyfromrecordset rst
        For j = 1 To rst.Fields.Count
            wrk.sheets(t).cells(1, j) = rst(j - 1).Name
        Next j
    Next i
    app.Visible = True
End Sub
В коде имеется обращение к массиву. Массив, как я понял - список с именами таблиц. В рамках задачи от меня требуется возможность "выбрать таблицы" (крайне желательно с выводом имён таблиц на форму). Вот в том, как реализовать этот момент разобраться пока не получается
Окажите помощь, если возможно
Ethex вне форума Ответить с цитированием
Старый 26.06.2017, 16:50   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

Цитата:
Сообщение от Ethex Посмотреть сообщение
В рамках задачи от меня требуется возможность "выбрать таблицы" (крайне желательно с выводом имён таблиц на форму)
поиском нашёл такой запрос
Код:
SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Type=1;
попробуйте.
Serge_Bliznykov вне форума Ответить с цитированием
Старый 27.06.2017, 11:24   #3
Ethex
Пользователь
 
Регистрация: 26.04.2017
Сообщений: 86
По умолчанию

Попробовал

Код:
Public Sub SelectNames()
Dim rst As DAO.Recordset

Set rst = CurrentDb.OpenRecordset("SELECT MSysObjects.Name FROM MSysObjects WHERE MSysObjects.Type = 1")
Set Me.[Список0].Recordset = rst
   
rst.Close: Set rst = Nothing

End Sub
Не срабатывает

Когда ставил метку и делал шаги, при наведении на
Код:
Set Me.[Список0].Recordset
Выводило Set Me.[Список0].Recordset = Nothing

Запрос, в теории, вытащит имена всех таблиц. А есть ли возможность "выбирать" таблицы, имена которых нужны? Кликнул мышью по таблице, нажал на кнопку формы, имя перенеслось?
Ethex вне форума Ответить с цитированием
Старый 27.06.2017, 11:43   #4
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от Ethex Посмотреть сообщение
возможность "выбрать таблицы" (крайне желательно с выводом имён таблиц на форму).
см архив
Вложения
Тип файла: zip Database2.zip (24.5 Кб, 17 просмотров)
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 28.06.2017, 11:16   #5
Ethex
Пользователь
 
Регистрация: 26.04.2017
Сообщений: 86
По умолчанию

Прошу прощения за то, что так затянул с ответом

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение
см архив
Aleksandr H., вы в очередной раз меня выручили.
Получив форму, я пытался избавится от этих скрытых/системных элементов в списке.
Додумался до такого:
Код:
Private Sub Кнопка12_Click()
    Dim aob As AccessObject
    Dim line As String
    Dim i As Integer
    With CurrentData
        For Each aob In .AllTables
            line = aob.Name
            If InStr(aob.Name, "MSys") > 0 Then
                line = line & " <-- Hidden/System Item"
            End If
            Me.Список4.AddItem Item:=line
        Next
    End With
    For i = 0 To 12
    Me!Список4.RemoveItem 0
    Next
End Sub
Этих элементов 13 (кол-во таблиц не влияет на их кол-во). Цикл в конце удаляет их из списка. Работает. Ещё поменял два других цикла.
Код:
Dim intItemsInList As Integer
    Dim intCounter As Integer
    intItemsInList = Me!Список20.ListCount
    For intCounter = intItemsInList - 1 To 0 Step -1
      Me![Список20].RemoveItem 0
    Next
End Sub
Проверил. Получилось то, что мне нужно. И всё бы хорошо, но...
Позже начнутся приколы
Дело в том, что менял код я прямо в том файле из архива. Потом перенёс оттуда
Ethex вне форума Ответить с цитированием
Старый 28.06.2017, 11:26   #6
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

Цитата:
Сообщение от Ethex Посмотреть сообщение
Этих элементов 13 (кол-во таблиц не влияет на их кол-во). Цикл в конце удаляет их из списка. Работает.
ООО! НЕТ! Зачем?! Зачем удалять их из списка, когда можно (И НУЖНО) не помещать их в список?!
Код:
Private Sub Кнопка12_Click()
    Dim aob As AccessObject
    Dim line As String
    Dim i As Integer
    With CurrentData
        For Each aob In .AllTables
            line = aob.Name
            If InStr(aob.Name, "MSys") = 0 Then
                Me.Список4.AddItem Item:=line
            End If
        Next
    End With
End Sub
Serge_Bliznykov вне форума Ответить с цитированием
Старый 28.06.2017, 11:27   #7
Ethex
Пользователь
 
Регистрация: 26.04.2017
Сообщений: 86
По умолчанию

Перенёс оттуда форму в свой файл с другой формой. Дома с флэшки запустил файл. По какой-то причине на домашнем ноуте программа работала не так как нужно: нажатие кнопки добавляло одно имя из существующих таблиц. Ещё один клик - ещё одно имя. Если кликов больше, чем имён - заносил повторно.

Приехал на работу. Снёс форму из файла. Создал новую, переписал код. Запускаю - выдаёт ошибку 6014. Требует указать тип источника данных для строки
Код:
Me.Список0.AddItem Item:=itm
Я то может и разберусь, как указать ему RecordSourseType. Но почему один и тот же код ведёт себя по разному в разных файлах???
Ethex вне форума Ответить с цитированием
Старый 28.06.2017, 11:39   #8
Ethex
Пользователь
 
Регистрация: 26.04.2017
Сообщений: 86
По умолчанию

Цитата:
Сообщение от Serge_Bliznykov Посмотреть сообщение
ООО! НЕТ! Зачем?!
На опережение сработали. Спасибо.
Я знал что способ, до которого я додумался не очень грамотен и рано или поздно наверняка мне пришлось бы выяснять иной
Ethex вне форума Ответить с цитированием
Старый 28.06.2017, 11:43   #9
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

Цитата:
Сообщение от Ethex Посмотреть сообщение
На опережение сработали. Спасибо.
не за что.
на самом деле, переменная line лишняя, поэтому можно ещё сократить код:

Код:
Private Sub Кнопка12_Click()
    Dim aob As AccessObject
    With CurrentData
        For Each aob In .AllTables
            If InStr(aob.Name, "MSys") = 0 Then
                Me.Список4.AddItem Item:=aob.Name
            End If
        Next
    End With
End Sub
Serge_Bliznykov вне форума Ответить с цитированием
Старый 28.06.2017, 14:07   #10
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Ну так что, вопрос решен или как?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перенос значений таблиц из Excel в несколько таблиц Word средствами VBA apfu00 Microsoft Office Excel 0 19.10.2016 16:51
Обращение к элементу дб access leonidbushuev БД в Delphi 1 19.01.2013 11:44
Обращение к таблице Access из Delphi Ягик БД в Delphi 4 13.03.2011 10:26
VBA, Excel 2007 обращение к элементам ActiveX smallfry Microsoft Office Excel 2 03.11.2010 11:43
Firebird Получение имён таблиц и список полей определённой таблицы Alexei91 БД в Delphi 5 02.08.2010 14:00