Создание Excel из визуального доступа MS из функции - PullRequest
Новая
       17

Создание Excel из визуального доступа MS из функции

0 голосов
/ 29 мая 2019

Я пытаюсь создать документ в Excel из Visual Basic 6 MS-Access со следующим кодом, который вызывает функцию TraeDatosCorteAnterior , которая выполняет запрос в базе данных, генерирует приложение Excel идобавляет рабочий лист.Работайте, однако, продолжая генерировать документ из функции ** ConstruyeTablayCampo **, применяя ошибку 424 со следующим сообщением ** «Требуется объект» **:

** Объект Excelобъявление **

Option Compare Database
Dim ba As Excel.Application

Начальная функция 

  Public Sub TraeDatosCorteAnterior()

    RstName = "SELECT conc.CP, conc.etapa, conc.total FROM t_conclusion as conc;"
    Dim dbs As Database
    Set dbs = CurrentDb
    Dim iRec As Long
    Dim i As Long
    Dim RstOrig As Recordset
    Dim nTotalReg As Integer
    Dim nCP As Integer
    Dim nEtapa As Integer 
    Dim nTotal As Integer

    Set RstOrig = CurrentDb.OpenRecordset(RstName, dbOpenDynaset)
    RstOrig.Sort = fldName
    Dim RstSorted As Recordset
    Set RstSorted = RstOrig.OpenRecordset()
    RstOrig.Sort = fldName
    Dim RstSorted As Recordset
    Set RstSorted = RstOrig.OpenRecordset()
    RstSorted.MoveLast
    RstSorted.MoveFirst

    nTotalReg = RstSorted.RecordCount

    nCP = RstSorted("CP")

    nEtapa = IIf(IsNull(RstSorted("etapa")) = True, 0, RstSorted("etapa"))
    nTotal = IIf(IsNull(RstSorted("Total")) = True, 0, RstSorted("Total"))

    RstSorted.MoveNext


    Set ba = New Excel.Application
    Set xlwbook = ba.Workbooks.Add
    ba.Visible = True

    ConstruyeTablayCampo "Cuadro I", "Cuenta Pública", "A", "A", ba, False, 1

  End Sub

** Функция, которая создает документ **, в первой строке отмечает ошибку.

** Объявление объекта Excel **

 Sub ConstruyeTablayCampo(ByRef sHoja As String, ByRef sTexto As String, ByRef col1 As String, ByRef col2 As String, ByRef ba As Excel.Application, Optional bCreaHoja As Boolean, Optional nHoja As Integer)

        Set xlsheet = xlwbook.Sheets.Item(nHoja)
        xlwbook.Sheets.Item(nHoja).Name = sHoja

        xlsheet.Cells.Range("A11:A11") = sTexto
        Worksheets("Cuadro I").Range("B:B,D:D,H:H,J:J,N:N,Q:Q").ColumnWidth = 1

        With xlsheet.Cells.Range(col1 & "11:" & col2 & "12")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = True
                .Select
                .Font.Bold = True
                .MergeCells = True
                .Interior.Color = RGB(244, 244, 244)
        End With

End Sub

Заранее спасибо, надеюсь, вы мне поможете!

1 Ответ

0 голосов
/ 30 мая 2019

Наконец, я решил, решение было сделать это:

Сначала объявите это 

Option Compare Database

Dim ba As Excel.Application
Dim xlwsheet As Excel.Worksheet

Вторая инициализация объекта во второй строке: 

 Sub ConstruyeTablayCampo(ByRef sHoja As String, ByRef sTexto As String, ByRef col1 As String, ByRef sRango1 As String, ByRef col2 As String, ByRef sRango2 As String, ByRef ba As Excel.Application, ByRef color1 As String, ByRef color2 As String, ByRef color3 As String, ByRef nHoja As Integer)

        Set xlwsheet = ba.Worksheets.Item(nHoja)
        xlwsheet.Name = sHoja
        xlwsheet.Range("B:B,D:D,H:H,J:J,N:N,Q:Q").ColumnWidth = 1

        With xlwsheet.Cells.Range(col1 & "11" & ":" & col2 & "12")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = True
                .Select
                .Font.Bold = True
                .MergeCells = True
                .Interior.Color = RGB(color1, color2, color3)
        End With

        xlwsheet.Range(col1 & "11:" & col2 & "12").Cells = sTexto

End Sub

Спасибо за вашу помощь!

...