Форум программистов, компьютерный форум, киберфорум
Наши страницы
MS Access
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/4: Рейтинг темы: голосов - 4, средняя оценка - 5.00
Sima42
0 / 0 / 0
Регистрация: 06.08.2011
Сообщений: 18
1

Выгрузка в Excel

17.12.2017, 14:23. Просмотров 727. Ответов 13
Метки нет (Все метки)

Здравствуйте!
Возникла проблема!
Нужно из MS Access перенести в Excel. Вроде банально, но нужно во время переноса изменять данные. Есть поле "Работа" это список значений "1 - Работает";"2 - Безработный";"3 - И т.д" а нужно что бы в Excelе было "1", "2" или "3".
0
Вложения
Тип файла: rar Documents.rar (35.9 Кб, 6 просмотров)
Лучшие ответы (1)
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
17.12.2017, 14:23
Ответы с готовыми решениями:

Выгрузка в Excel
Я выгружаю данные в Excel макрокомандой ПреобразоватьЭлектроннуюТаблицу. Мне нужно, чтобы в...

Выгрузка в Excel с редактированием
Здравствуйте, Есть таблица в access в которой с помощью запросов формируется итоговая...

Выгрузка данных из Access в Excel
Здравствуйте форумчане! Подскажите в Access есть возможность выгрузить данные в Excel, как у меня в...

Выгрузка данных формы в Excel
Здравствуйте! Помогите, пожалуйста, с таким вопросом. У меня есть форма, в которой создано поле со...

Выгрузка Запроса Access в Форму Excel
Всем доброго дня. Есть необходимость выбрать данные запросом из базы и вывести их на форму в Excel....

13
Eugene-LS
3905 / 2255 / 428
Регистрация: 05.10.2016
Сообщений: 6,273
17.12.2017, 14:48 2
Лучший ответ Сообщение было отмечено Sima42 как решение

Решение

Цитата Сообщение от Sima42 Посмотреть сообщение
а нужно что бы в Excelе было "1", "2" или "3".
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
Private Sub Кнопка2_Click()
 
Dim strsql, temp1, rst As DAO.Recordset
Dim r%, c%
Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
 
   'Start a new workbook in Excel
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
 
 
   'Add data to cells of the first worksheet in the new workbook
   Set oSheet = oBook.Worksheets(1)
   oSheet.Range("A1").Value = "Код"
   oSheet.Range("B1").Value = "Имя"
   oSheet.Range("C1").Value = "Кол-во"
   oSheet.Range("D1").Value = "Дата"
   oSheet.Range("F1").Value = "Адрес"
   oSheet.Range("G1").Value = "Семейное положение"
 
   'Save the Workbook and Quit Excel
   
  Set rst = CurrentDb.OpenRecordset("Таблица1", dbOpenSnapshot)  'Только просмотр
 
    r = 1
    With rst
        Do Until .EOF = True 'Цикл до конца таблицы
            '...операции с записью
            'Тут так: cells(lRowNo, lColumnNo)
            r = r + 1
            For c = 1 To 6
                oExcel.cells(r, c) = rst.Fields(c - 1).Value
            Next c
            .MoveNext
        Loop
    End With
   
 
   oBook.SaveAs CurrentProject.Path & "\Book1.xls"
   oExcel.Quit
   
 
    MsgBox "Готово"
    
On Error Resume Next
    rst.Close
    Set rst = Nothing
 
End Sub
1
Sima42
0 / 0 / 0
Регистрация: 06.08.2011
Сообщений: 18
17.12.2017, 14:57  [ТС] 3
Большое человеческое СПАСИБО!!!!!!!!!!! Очень выручил.
0
Eugene-LS
3905 / 2255 / 428
Регистрация: 05.10.2016
Сообщений: 6,273
17.12.2017, 15:01 4
Sima42, Я поторопился и не туда посмотрел

Вот правильный вариант:

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 Кнопка2_Click()
 
Dim strsql, temp1, rst As DAO.Recordset
Dim r%, c%
Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
 
   'Start a new workbook in Excel
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
 
 
   'Add data to cells of the first worksheet in the new workbook
   Set oSheet = oBook.Worksheets(1)
   oSheet.Range("A1").Value = "Код"
   oSheet.Range("B1").Value = "Имя"
   oSheet.Range("C1").Value = "Кол-во"
   oSheet.Range("D1").Value = "Дата"
   oSheet.Range("E1").Value = "Работа"
   oSheet.Range("F1").Value = "Адрес"
   oSheet.Range("G1").Value = "Семейное положение"
 
   'Save the Workbook and Quit Excel
   
  Set rst = CurrentDb.OpenRecordset("Таблица1", dbOpenSnapshot)  'Только просмотр
 
    r = 1
    With rst
        Do Until .EOF = True 'Цикл до конца таблицы
            '...операции с записью
            'Тут так: cells(lRowNo, lColumnNo)
            r = r + 1
            For c = 1 To 7
                Select Case c
                    Case 5, 7
                        If IsNull(rst.Fields(c - 1).Value) = False Then
                            oExcel.cells(r, c) = Mid(rst.Fields(c - 1).Value, 1, 1)
                        End If
                    Case Else
                        oExcel.cells(r, c) = rst.Fields(c - 1).Value
                End Select
            Next c
            .MoveNext
        Loop
    End With
   
 
   oBook.SaveAs CurrentProject.Path & "\Book1.xls"
   oExcel.Quit
   
 
    MsgBox "Готово"
    
On Error Resume Next
    rst.Close
    Set rst = Nothing
 
 
End Sub
0
17.12.2017, 15:01
Sima42
0 / 0 / 0
Регистрация: 06.08.2011
Сообщений: 18
17.12.2017, 15:03  [ТС] 5
Я уже это дописал
0
mobile
Эксперт MS Access
23746 / 13301 / 2807
Регистрация: 28.04.2012
Сообщений: 14,564
17.12.2017, 15:10 6
Можно немного попроще, используя CopyFromRecordset и, заменяя с помощью Val, текстовые значения на числа
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub Кнопка2_Click()
 
Dim strsql, temp1, i, rst As DAO.Recordset
Dim oExcel As Object, oBook As Object, oSheet As Object
   'Start a new workbook in Excel
    Set oExcel = CreateObject("Excel.Application")
    Set oBook = oExcel.Workbooks.Add
    
    strsql = "select Код, Имя, [Кол-во], [Дата], " _
    & "val(Таблица1.Работа) as Работа, Адрес, " _
    & "val(Таблица1.[Семейное положение]) as [Семейное положение] " _
    & "from Таблица1"
    Set rst = CurrentDb.OpenRecordset(strsql)
    For i = 0 To rst.Fields.Count - 1
        oExcel.cells(1, i + 1) = rst.Fields(i).Name
    Next
    oExcel.cells(2, 1).copyfromrecordset rst
    'Save the Workbook and Quit Excel
    oBook.SaveAs "D:\Book1.xls"
    oExcel.Quit
    MsgBox "Готово"
End Sub
2
Sima42
0 / 0 / 0
Регистрация: 06.08.2011
Сообщений: 18
17.12.2017, 15:22  [ТС] 7
Как вы думаете какой метод будет более уместный? 1 таблица примерно 250 полей. Много полей со списками значений и их и нужно будет обрабатывать (по принципу что сверху).
0
Eugene-LS
3905 / 2255 / 428
Регистрация: 05.10.2016
Сообщений: 6,273
17.12.2017, 15:53 8
Цитата Сообщение от Sima42 Посмотреть сообщение
Как вы думаете какой метод будет более уместный?
Оба работают ...
Вариант от mobile, короче и более правильный, что-ли....

Ещё к обоим вариантам можно прикрутить такой код
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
'Выставляем ширину столбцов
    For c = 1 To 7
        Select Case c
            Case 1
                oExcel.Columns(c).ColumnWidth = 7
            Case 3, 4, 5
                oExcel.Columns(c).ColumnWidth = 12
            Case Else
                'oExcel.Columns(c).AutoFit
                oExcel.Columns(c).ColumnWidth = 24
        End Select
    Next c
    
'Задаём путь приложения
    intBoockNo = intBoockNo + 1
    i = CInt(Mid(Application.Version, 1, 2)) 'Версия MS Access
    If i > 11 Then 'Версия MS Access 2007 и выше (не 2003)
        s = CurrentProject.Path & "\Book" & Format(intBoockNo, "000") & ".xlsx"
    Else
        s = CurrentProject.Path & "\Book" & Format(intBoockNo, "000") & ".xls"
    End If
    
'Сохраняем в папке приложения
 
   oBook.SaveAs s
   oExcel.Visible = True
   'oExcel.Quit
   
 
    MsgBox "Готово", vbInformation
Причём: intBoockNo (номер файла) объявляем на уровне модуля
Visual Basic
1
Private intBoockNo As Integer
0
Sima42
0 / 0 / 0
Регистрация: 06.08.2011
Сообщений: 18
17.12.2017, 16:37  [ТС] 9
Спасибо вам всем огромное за ответы!
0
mobile
Эксперт MS Access
23746 / 13301 / 2807
Регистрация: 28.04.2012
Сообщений: 14,564
17.12.2017, 17:04 10
Цитата Сообщение от Sima42 Посмотреть сообщение
таблица примерно 250 полей. Много полей со списками значений и их и нужно будет обрабатывать (по принципу что сверху).
При таком количестве полей вручную их описывать и модифицировать запаришься. Предлагаю вариант с автоматическим построением sql запроса с помощью функции makeSql
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
Private Sub Кнопка2_Click()
 
Dim strsql, temp1, i, rst As DAO.Recordset
Dim oExcel As Object, oBook As Object, oSheet As Object
   'Start a new workbook in Excel
    Set oExcel = CreateObject("Excel.Application")
    Set oBook = oExcel.Workbooks.Add
    
    strsql = makeSql("Таблица1")
    Set rst = CurrentDb.OpenRecordset(strsql)
    For i = 0 To rst.Fields.Count - 1
        oExcel.cells(1, i + 1) = rst.Fields(i).Name
    Next
    oExcel.cells(2, 1).copyfromrecordset rst
    'Save the Workbook and Quit Excel
    oBook.SaveAs "D:\Book1.xls"
    oExcel.Quit
    MsgBox "Готово"
End Sub
 
Function makeSql(nameTbl)
'nameTbl - имя таблицы
    Dim tdf As TableDef, db As DAO.Database, fld As Field
    Dim s, i, k
    Set db = CurrentDb
    Set tdf = db.TableDefs(nameTbl)
    For Each fld In tdf.Fields
        k = fld.Name
        On Error Resume Next
        i = fld.Properties("rowsource")
        If Err = 0 Then
            s = s & ",Val([" & nameTbl & "].[" & k & "]) as [" & k & "]"
        Else
            s = s & ",[" & k & "]"
        End If
        Err.Clear
    Next
    s = "select " & Mid(s, 2) & " from " & nameTbl
    makeSql = s
End Function
2
Eugene-LS
3905 / 2255 / 428
Регистрация: 05.10.2016
Сообщений: 6,273
17.12.2017, 17:44 11
Я тут себе, примерчик соорудил по данной теме (на память).
Если интересно, то вот:
1
Миниатюры
Выгрузка в Excel  
Вложения
Тип файла: zip Export_to_Excel-v02.zip (70.3 Кб, 11 просмотров)
Sima42
0 / 0 / 0
Регистрация: 06.08.2011
Сообщений: 18
18.12.2017, 08:58  [ТС] 12
Еще бы добавить по связанным таблицам, и вообще универсальная база

Добавлено через 2 часа 14 минут
А как быть если 2 таблицы связанные 1 к 1 то как быть тогда?

Добавлено через 10 часов 11 минут
Все верно! Чего боялся то и получилось. Пришел на работу. Открыл базу а там 2 таблицы связанные 1 к 1.
0
mobile
Эксперт MS Access
23746 / 13301 / 2807
Регистрация: 28.04.2012
Сообщений: 14,564
18.12.2017, 09:06 13
Цитата Сообщение от Sima42 Посмотреть сообщение
Еще бы добавить по связанным таблицам, и вообще универсальная база

А как быть если 2 таблицы связанные 1 к 1 то как быть тогда?
Это запросами. Но надо иметь в виду, что в запросах, как и в таблицах, не может быть больше 255 полей.

Смотрите вложение. Скопируйте Form1 к себе в БД. В форме есть актуальный список таблиц/запросов. Выбираете нужный и жмете кнопку Послать...в Excel. Можно выбрать путь и имя книги в самом нижнем поле.
На всякий случай вверху формы есть кнопка Обновить список таблиц/запросов. Если форма открыта и Вы сделали новый запрос или таблицу, которых еще нет в списке, то кнопка поместит их в список.
0
Вложения
Тип файла: rar пример с выгрузкой в excel.rar (24.8 Кб, 9 просмотров)
Sima42
0 / 0 / 0
Регистрация: 06.08.2011
Сообщений: 18
18.12.2017, 09:45  [ТС] 14
Цитата Сообщение от mobile Посмотреть сообщение
Это запросами. Но надо иметь в виду, что в запросах, как и в таблицах, не может быть больше 255 полей.
А там явно будет больше. Я тут первый пример доделал под 2 таблицы. Не совсем будет быстро работать. Но там полей много а строк максимум 50. Только вопрос почему когда екселевский файл открываешь, ещё книга открывается.

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
69
Private Sub Кнопка1_Click()
 
Dim strsql, temp1, rst As DAO.Recordset
Dim r%, c%, r1%
Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add
 
   Set oSheet = oBook.Worksheets(1)
   oSheet.Range("A1").Value = "Код"
   oSheet.Range("B1").Value = "Имя"
   oSheet.Range("C1").Value = "Кол-во"
   oSheet.Range("D1").Value = "Дата"
   oSheet.Range("E1").Value = "Работа"
   oSheet.Range("F1").Value = "Адрес"
   oSheet.Range("G1").Value = "Семейное положение"
 Set rst = CurrentDb.OpenRecordset("Таблица1", dbOpenSnapshot)  'Только просмотр
    r = 1
    With rst
        Do Until rst.EOF = True
            r = r + 1
            For c = 1 To 7
                Select Case c
                    Case 5, 7
                        If IsNull(rst.Fields(c - 1).Value) = False Then
                            oExcel.cells(r, c) = Mid(rst.Fields(c - 1).Value, 1, 1)
                        End If
                    Case Else
                        oExcel.cells(r, c) = rst.Fields(c - 1).Value
                    End Select
            Next c
            rst.MoveNext
            Set rst1 = CurrentDb.OpenRecordset("Таблица2", dbOpenSnapshot)
            With rst1
                Do Until rst1.EOF = True
                    If oExcel.cells(r, 1) = rst1.Fields(0) Then
                       For c = 1 To 7
                            Select Case c
                                Case 2, 3
                                    If IsNull(rst1.Fields(c - 1).Value) = False Then
                                        oExcel.cells(r, c + 7) = Mid(rst1.Fields(c - 1).Value, 1, 1)
                                    End If
                                Case Else
                                    oExcel.cells(r, c + 7) = rst1.Fields(c - 1).Value
                            End Select
                        Next c
                    End If
                rst1.MoveNext
                Loop
            End With
        Loop
    End With
   oBook.SaveAs CurrentProject.Path & "\Book1.xls"
   oExcel.Quit
   
    On Error Resume Next
    rst.Close
    Set rst = Nothing
    
    On Error Resume Next
    rst1.Close
    Set rst1 = Nothing
    
    MsgBox "Готово"
 
 
End Sub
0
18.12.2017, 09:45
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
18.12.2017, 09:45

Выгрузка запроса и генерация формул в Excel
Доброе утро, делаю выгрузку запроса в Excel (количество строк всегда разное). После этого...

Выгрузка данных из таблицы MS Access в MS excel
Добрый день , форумчане. Столкнулся с такой проблемой - имеется база данных, в ней несколько...

Выгрузка из Explorer в Excel через Access
Добрый день. Давно не работал с Access (лет этак 17, если быть точным). И вот на работе возникла...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
14
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2019, vBulletin Solutions, Inc.
Рейтинг@Mail.ru