Добро пожаловать в форум, Guest  >>   Войти | Регистрация | Поиск | Правила | В избранное | Подписаться
Все форумы / Microsoft Access Новый топик    Ответить
 Многоязычный экспорт в Эксель.  [new]
WalkManX
Member

Откуда:
Сообщений: 68
Добрый день!

Прошу помощи так как сам не особо силен в VBA, у меня есть база Access, которая работает на 3 языках, перевод хранится в таблице "tblTranslation"
control rom rus engl
название столбца 1 что то на одном языке что то на втором языке что то на третьем языке
название столбца 2 что то другое на одном языке что то другое на втором языке что то другое на третьем языке


И есть функция которая делает экспорт данных в эксель

+
Sub StajInExcel (код As Double)
On Error GoTo Err_StajInExcel
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim objPivotCache As Excel.PivotCache
    Dim MyRange As Excel.Range
    Dim rs As New ADODB.Recordset

    rs.CursorLocation = adUseClient 'Рекордсет будет создан у клиента
    rs.Open "SELECT First(Таблица.Дата) AS Дата, First(Таблица.Время) AS Время, Sum(Таблица.X1) AS X, Таблица.Номер1 AS [Номер] " & _
            "FROM Таблица GROUP BY Таблица.Номер1, Таблица.Код, Таблица.Дата, Таблица.Время, Таблица.Номер1 HAVING (((First(Таблица.Код))=" & код & ") AND " & _
            "((Count(Таблица.Код))>1) AND ((Count(Таблица.Время))>1));", _
        CurrentProject.Connection, adOpenStatic, adLockReadOnly, adCmdText

    Set xlApp = CreateObject("Excel.Application") 'Создание объекта MSExcel
    Set xlBook = xlApp.Workbooks.Add 'Создание файла Excel
    'xlApp.Visible = True 'Выводим на экран (оставлено для возможной отладки)
    xlApp.DisplayAlerts = False 'Запрет возможных сообщений MSExcel

    Set xlSheet = xlBook.Sheets(1)
    With xlSheet
        .Name = "Сводная" 'Присваивем листу имя
        'Создаем сводную таблицу с внешним источником данных (xlExternal)
        Set objPivotCache = xlBook.PivotCaches.Add(xlExternal)
        'Присваиваем сводной таблице в качестве источника данных рекордсет (rs)
        Set objPivotCache.Recordset = rs
        rs.Close 'Закрываем рекордсет, т.к. он больше не нужен
        Set rs = Nothing 'Чистим память от объекта

        'Создаем каркас для сводной и указываем что будет строками, а что столбцами
        .PivotTables.Add PivotCache:=objPivotCache, TableDestination:=.Cells(2, 1), TableName:="Svodnaya"
        With .PivotTables("Svodnaya").PivotFields("Дата")
            .Orientation = xlRowField 'Строка
            .Position = 1 'Позиция №1
        End With
        With .PivotTables("Svodnaya").PivotFields("Время")
            .Orientation = xlRowField 'Строка
            .Position = 2 'Позиция №2
        End With
        With .PivotTables("Svodnaya").PivotFields("Номер")
            .Orientation = xlColumnField 'Столбец
            .Position = 1 'Позиция №1
        End With

        'Подбиваем суммы по группам
        .PivotTables("Svodnaya").AddDataField .PivotTables _
            ("Svodnaya").PivotFields("X"), "X"  ', xlSum
        
        '=================================================================================
        'Сводная таблица создана!
        '=================================================================================

        '=================================================================================
        'Рисуем диаграмму
        '=================================================================================
        'Добавляем диаграмму (тип - xlColumnClustered) на новый лист
        xlApp.Charts.Add
        xlApp.ActiveChart.ChartType = xlColumnClustered
        xlApp.ActiveChart.PlotArea.Interior.ColorIndex = xlNone 'Обесцвечиваем подложку (фон)
        xlApp.ActiveChart.HasTitle = True 'Отображение заголовка диаграммы
        xlApp.ActiveChart.ChartTitle.Characters.Text = "Диаграмма"
        xlApp.ActiveChart.Legend.Position = xlTop 'Вывод легенды сверху диаграммы
        xlApp.ActiveSheet.Name = "Диаграмма" 'Наименование листа
        .Visible = xlSheetVeryHidden
    End With

    'Скрываем 'повылазившие' панели инструментов
    xlApp.ActiveWorkbook.ShowPivotTableFieldList = False
    xlApp.CommandBars("PivotTable").Visible = False
    xlApp.CommandBars("Chart").Visible = False
    'Сохранение файла под именем Staj.xls
    xlBook.SaveAs FileName:=CurrentProject.Path & "\Staj", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    xlApp.DisplayAlerts = True 'Разрешаем сообщения MSExcel
   xlApp.Visible = True 'Выводим на экран
xlApp.CalculateFull
    Set xlSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing

Exit Sub
Err_StajInExcel:
    MsgBox Err.Description, vbCritical + vbMsgBoxHelpButton, _
        "Ошибка №" & Err.number, Err.HelpFile, Err.HelpContext
    On Error Resume Next
    xlApp.Quit
End Sub


Как сделать чтобы названия столбцов в экселе, тоже переводились в зависимости от выбранного языка в базе?
За выбранный язык в базе отвечает функция "CurrentLanguge" которая возвращает значение: "rus", "engl" или "rom" которое соответствует названию столбцов в таблице с переводом.
Заранее благодарю.
8 фев 20, 18:14    [22076074]     Ответить | Цитировать Сообщить модератору
 Re: Многоязычный экспорт в Эксель.  [new]
Кривцов Анатолий
Member

Откуда:
Сообщений: 446
Сузя по всему "названия столбцов в экселе", это названия столбцов в Recordset-е, а там они задаются явно, например First(Таблица.Дата) AS Дата. Там и меняйте.
10 фев 20, 10:18    [22076541]     Ответить | Цитировать Сообщить модератору
 Re: Многоязычный экспорт в Эксель.  [new]
WalkManX
Member

Откуда:
Сообщений: 68
Кривцов Анатоли, спасибо за отклик
Где менять я понял, вопрос в том как сделать что бы нужный вариант перевода подбирался из таблицы "tblTranslation" ? временно сделал так

    Dim sPAR As String, sCapPAR As String

    sPAR = CurrentLanguage
     Select Case sPAR
     Case "rom"
      sCapPAR = "Вариант1"
      Case "engl"
      sCapPAR = "Вариант2"
      Case "rus"
      sCapPAR = "Вариант3"
      End Select

   rs.CursorLocation = adUseClient 'Рекордсет будет создан у клиента
    rs.Open "SELECT First(Таблица.Дата) AS  [color=red] & sCapPAR & [/color], First(Таблица.Время) AS Время, Sum(Таблица.X1) AS X, Таблица.Номер1 AS [Номер] " & _
            "FROM Таблица GROUP BY Таблица.Номер1, Таблица.Код, Таблица.Дата, Таблица.Время, Таблица.Номер1 HAVING (((First(Таблица.Код))=" & код & ") AND " & _
            "((Count(Таблица.Код))>1) AND ((Count(Таблица.Время))>1));", _
        CurrentProject.Connection, adOpenStatic, adLockReadOnly, adCmdText



но так в случаии если надо что то отредактировать, надо лезть в сам код VBA, хотелось-бы этого избежать...

Сообщение было отредактировано: 12 фев 20, 20:14
12 фев 20, 19:29    [22078739]     Ответить | Цитировать Сообщить модератору
 Re: Многоязычный экспорт в Эксель.  [new]
Кривцов Анатолий
Member

Откуда:
Сообщений: 446
WalkManX
перевод хранится в таблице "tblTranslation"
control rom rus engl
название столбца 1 что то на одном языке что то на втором языке что то на третьем языке
название столбца 2 что то другое на одном языке что то другое на втором языке что то другое на третьем языке
Если "название столбца 1", это, например, "Дата", а "что то на третьем языке", это "Date", получить его можно функцией DLookup:
 sPAR = CurrentLanguage
 sCapPAR = DLookup(sPAR, "tblTranslation", "[control]='Дата'")

Если таких обращений в процедуре много, то лучше открыть Recordset на таблице "tblTranslation", искать нужную запись и брать значение из нужного поля. Это будет быстрее.
13 фев 20, 12:00    [22079121]     Ответить | Цитировать Сообщить модератору
 Re: Многоязычный экспорт в Эксель.  [new]
WalkManX
Member

Откуда:
Сообщений: 68
Кривцов Анатолий,

Да, обращений предполагается много.

Попробовал переделать функцию которая переводит формы в базе, вот что получилось.
Как я уже говорил не особо силен в VBA, так как не учился на программиста, не судите строго.
Public Function TranslateSeek(Optional TranslateSTR As String = "") As String
Dim rst As ADODB.Recordset
Dim strLanguage As String

    strLanguage = CurrentLanguage

Set rst = New ADODB.Recordset
rst.Open "SELECT Control, " & strLanguage & " FROM tblTranslation " _
, CurrentProject.Connection, adOpenKeyset, adLockReadOnly
rst.MoveFirst

rst.Find "Control =  '" & TranslateSTR & "'"
If rst.BOF Or rst.EOF Then
Else
TranslateSeek = rst(strLanguage)
rst.MoveFirst
End Function

Подскажите на сколько сильно я "намудрил" ? :D
13 фев 20, 15:54    [22079362]     Ответить | Цитировать Сообщить модератору
 Re: Многоязычный экспорт в Эксель.  [new]
Predeclared
Member

Откуда: And God I know I'm one
Сообщений: 931
Не сильно.
Здесь сильнее намудрено: 16939740
13 фев 20, 22:47    [22079638]     Ответить | Цитировать Сообщить модератору
Все форумы / Microsoft Access Ответить