Экспорт данных в шаблон Exel из MS Access 2

@Маринка22 · Регистрация: 23.11.2017

Студворк — интернет-сервис помощи студентам

Добрый день.
Уважаемый mobile, у вас так легко получается помогать людям. Прочитала эту тему Экспорт данных в шаблон Exel из MS Access и решила к вам обратиться с таким же вопросом, ведь правилами запрещено лезть со своим добром в чужой монастырь.
У нас есть база в детском саду и нужно сводить отчет по родственникам. Пробовала сделать по вашему примеру, но что-то пошло не так

Экспортируем в ексель данные, но родственники не появляются и степень родства тоже.
Нужно, чтобы при нажатии на кнопку "Печать" данные из акцесс выходили в шаблон екселя в табличном виде.
И возможно ли сделать автоматическую нумерацию столбика "№ п/п", или это сложно сделать? Наставьте на путь истинный.

И файл экселя появляется почему-то не в полноэкранном режиме, а окошком.

@Eugene-LS · 23.11.2017, 20:35

Сообщение от Маринка22

Нет, это такой шаблон.

Внимание - шаблон исправил - была ошибка формата (замучился искать) - работаем с "Книга2.xltx"

Код:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Private Sub Печатать_Click()
Dim app As Object, wrk As Object
Dim iRow%, iColumn%, s$
Dim sColumn$
Dim iRecordNO%
 
'--------------------------------------------------------------------------
'MyChar = Chr(65)    ' Returns A.
On Error GoTo Печатать_Click_Err
    Set app = CreateObject("Excel.Application")
    Set wrk = app.workbooks.Open(CurrentProject.Path & "\Книга2.xltx")
    With Me
        app.range("A1") = !фамилия & " " & !имя & " " & !отчество
    End With
    
    iColumn = 66 '=B
    With Me.[родня подчиненная форма].Form.Recordset
        'Debug.Print .RecordCount
        .MoveFirst
        Do Until .EOF = True 'Цикл до конца таблицы
            iRow = 4
            iRecordNO = iRecordNO + 1 'Номер записи
            iColumn = iColumn + 1
            
            sColumn = Chr(iColumn)
            s = sColumn & iRow 'Повёрнуто!
            app.range(s) = iRecordNO
            iRow = iRow - 1
            
            s = sColumn & iRow
            app.range(s) = !фамилияР & " " & !имяР & " " & !отчествоР
            iRow = iRow - 1
            
            s = sColumn & iRow 'Форма родства
            app.range(s) = !форма
            iRow = iRow - 1
            
            s = sColumn & iRow '
            app.range(s) = !датаРождР & " "
            .MoveNext
        Loop
 
    End With
 
    app.WindowState = 3 'во весь экран
    app.Visible = True
 
 
    
Печатать_Click_Bye:
    Set wrk = Nothing
    Set app = Nothing
    Exit Sub
 
Печатать_Click_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Sub: Печатать_Click in module: Form_главная", _
    vbCritical, "Error in Application: " & Err.Source
    Err.Clear
    Resume Печатать_Click_Bye
    
End Sub

@Маринка22 · 24.11.2017, 07:10 **[ТС]**

А Вам говорили, что Вы волшебник?

Добавлено через 3 часа 0 минут

Сообщение от Eugene-LS

Внимание - шаблон исправил - была ошибка формата (замучился искать) - работаем

а можно подробнее в чем была проблема?

Добавлено через 13 минут
Кстати, если столбец дальше Z и идет начало столбцов АА, АВ, то данный код уже не работает. Пишет "error 1004"

@Маринка22 · 24.11.2017, 07:26 **[ТС]**

Насколько я поняла

Visual Basic
1
iColumn =

отвечает за столбец, где размещаются данные?
Вот в примере отодвинула на столбцы АА всю таблицу, поправила iColumn = 123

@Eugene-LS · 24.11.2017, 09:06

Сообщение от Маринка22

а можно подробнее в чем была проблема?

в формате ячеек.
Я с начал думал код не верный, и только побившись головой об стену - обнаружил что там где № п.п. в ячейке установлен формат даты ...

Сообщение от Маринка22

Кстати, если столбец дальше Z и идет начало столбцов АА, АВ, то данный код уже не работает. Пишет "error 1004"

Правильно (что не работает) там второй параметр нужно ввести на этот случай.

@Маринка22 · 24.11.2017, 09:28 **[ТС]**

Ну Вы же волшебник, введите пожалуйста

Добавлено через 6 минут

Кликните здесь для просмотра всего текста

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Private Sub Печатать_Click()
Dim app As Object, wrk As Object
Dim iRow%, iColumn%, s$
Dim sColumn$
Dim iRecordNO%
 
'--------------------------------------------------------------------------
'Cells(6, 5) или Cells(6, "E")
'Ячейка D5 текущего листа через свойство Cells. 5 - строка (row), 4 - столбец (column).
'Допустимость второй формы мало кому известна.
'MyChar = Chr(65)    ' Returns A.
On Error GoTo Печатать_Click_Err
    Set app = CreateObject("Excel.Application")
    Set wrk = app.workbooks.Open(CurrentProject.Path & "\Книга2.xltx")
    With Me
        app.range("AA1") = !фамилия & " " & !имя & " " & !отчество
    End With
    
    iColumn = 123 '=B
    With Me.[родня подчиненная форма].Form.Recordset
        'Debug.Print .RecordCount
        .MoveFirst
        Do Until .EOF = True 'Цикл до конца таблицы
            iRow = 4
            iRecordNO = iRecordNO + 1 'Номер записи
            iColumn = iColumn + 1
            
            sColumn = Chr(iColumn)
            s = sColumn & iRow 'Повёрнуто!
            app.range(s) = iRecordNO
            iRow = iRow - 1
            
            s = sColumn & iRow
            app.range(s) = !фамилияР & " " & !имяР & " " & !отчествоР
            iRow = iRow - 1
            
            s = sColumn & iRow 'Форма родства
            app.range(s) = !форма
            iRow = iRow - 1
            
            s = sColumn & iRow '
            app.range(s) = !датаРождР & " "
            .MoveNext
        Loop
 
    End With
    'app.DisplayFullScreen = False
    'app.WindowState = -4137 'во весь экран
    'app.Visible = True
 
    app.WindowState = 3 'во весь экран
    app.Visible = True
 
 
    
Печатать_Click_Bye:
    Set wrk = Nothing
    Set app = Nothing
    Exit Sub
 
Печатать_Click_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Sub: Печатать_Click in module: Form_главная", _
    vbCritical, "Error in Application: " & Err.Source
    Err.Clear
    Resume Печатать_Click_Bye
    
End Sub

@Eugene-LS · 24.11.2017, 10:54

Сообщение от Маринка22

Ну Вы же волшебник, введите пожалуйста

через 10-15 минут ...

@Eugene-LS · 24.11.2017, 11:07

Маринка22, короче так:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub Печатать_Click()
Dim app As Object, wrk As Object
Dim iRow%, iColumn%
Dim sColumn$
Dim iRecordNO%
 
'--------------------------------------------------------------------------
On Error GoTo Печатать_Click_Err
    
    
    Set app = CreateObject("Excel.Application")
    Set wrk = app.workbooks.Open(CurrentProject.Path & "\Книга2.xltx")
    With Me
        'Тут так: cells(iRowNo, iColumnNo)
        app.cells(1, 1) = !фамилия & " " & !имя & " " & !отчество
    End With
    
    iColumn = 2
    With Me.[родня подчиненная форма].Form.RecordsetClone
        'Debug.Print .RecordCount
        .MoveFirst
        Do Until .EOF = True 'Цикл до конца таблицы
            iRow = 4
            iRecordNO = iRecordNO + 1 'Номер записи
            iColumn = iColumn + 1
            
            app.cells(iRow, iColumn) = iRecordNO
            iRow = iRow - 1 'Повёрнуто!
            
            app.cells(iRow, iColumn) = !фамилияР & " " & !имяР & " " & !отчествоР
            iRow = iRow - 1
            
            app.cells(iRow, iColumn) = !форма
            iRow = iRow - 1
            
            app.cells(iRow, iColumn) = Format(Nz(!датаРождР), "dd.mm.yyyy")
            iRow = iRow - 1
            .MoveNext
        Loop
 
    End With
 
    app.WindowState = 3 'во весь экран
    app.Visible = True
 
 
    
Печатать_Click_Bye:
    Set wrk = Nothing
    Set app = Nothing
    Exit Sub
 
Печатать_Click_Err:
    MsgBox "Error: " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in Sub: Печатать_Click in module: Form_главная", _
    vbCritical, "Error in Application: " & Err.Source
    Err.Clear
    Resume Печатать_Click_Bye
    
End Sub

@Eugene-LS · 24.11.2017, 11:13

Маринка22, ах да! - Чуть не забыл!
Для удаления тестовых записей исполните:

SQL
1
DELETE FROM родня WHERE датаРождР IS NULL

@Маринка22 · 24.11.2017, 11:48 **[ТС]**

Я же говорила, волшебник, спасибо Вам огромное! Все получилось.

Новые блоги и статьи Все статьи Все блоги /
Nekobox - outbounds[0].transport: unknown transport type: raw damix 01.10.2026 Фикс ошибки Правым кликом по серверу -> отладочная информация -> edit Заменить "net": "raw", на "net": "tcp", Нажать кнопку reload.	Программный домашний кинотеатр russiannick 27.09.2026 Сподобился на программный домашний кинотеатр. В качестве ЯВУ по традиции выбрал js. В помощники взял Яндекс-Алису. Было создано три зала на разные интересы. исторические и ретро сериал Хичкок. . .	Беседа с ИИ о программистах, недопускающих к созданию и правке кода генеративные ИИ и причины этого zorxor 21.09.2026 Раньше я радовался или получал некоторые эмоции, пусть небольшие, но всё же, от самого процесса написания кода, рекомпиляции и запуска, видя постепенное развитие программы и прочее. А теперь лень. . .	Мобильное приложение ColorStep pavlinmavlin 17.09.2026 Реализовал приложение Красный, Зеленый, Синий в Unity3d + c#. Название изменил на ColorStep. Приложение прошло модерацию и теперь доступно для скачивания. Делал его сам, шаг за шагом — и вот,. . .
Запрет дублирования строк в табличной части Maks 13.09.2026 Реализация из решения ниже выполнена на нетиповом справочнике "Нормы ТО" с табличной часть "Виды ТО", разработанного в КА2, со следующими реквизитами: - ВидТО (СправочникСсылка. ВидыТО); - ВидГСМ. . .	Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Jin X 06.09.2026 Скрипты Tampermonkey для CyberForum, ChatGPT, Claude и пр. Работая с форумом и нейросетями в браузере часто хочется что-то подкорректировать или добавить какого-то функционала. Ниже прикреплён. . .	Программа опроса у.з. расходомера SLS-720F Argus19 02.09.2026 Программа опроса у. з. расходомера SLS-720F Программа опрашивает один раз в минуту три ультразвуковых расходомера SLS-720F через интерфейс RS-485 по протоколу Modbus RTU. Опрашиваются регистры. . .	Hyper-V: Компьютер должен поддерживать доверенный платформенный модуль 2.0. Maks 31.08.2026 При установке Windows 11 на виртуальную машину Hyper-V 2-го поколения вылезла такая ошибка: Решение: в параметрах виртуальной машины, в разделе "Безопасность" (Security) активировать флаг. . .

@Маринка22 1 / 1 / 1 Регистрация: 23.11.2017 Сообщений: 43
	24.11.2017, 11:48 [ТС]
	Я же говорила, волшебник, спасибо Вам огромное! Все получилось. 0