USE EXCEL IN VB6

sal21 · Post by **sal21** » 27 Oct 2021, 16:57

This is wath i have for testing excel in vb6....

Private Sub PRINT_REPORT()

'dichiarazioni
'dichiarazione dell'oggetto
    Dim sFile, xlWb As Object
    Set XL = CreateObject("Excel.Application")
    sFile = "C:\Lavori_Vb6\HOTEL\TEMPLATE.XLS"
    Set xlWb = XL.Workbooks.Open(FileName:=sFile, Editable:=True)
    XL.Visible = True    'vedi il foglio mentre si compone
    'XL.Workbooks.Add    'aggiunge foglio EXCEL
    XL.Activesheet.Name = "REPORT"
    'per scrivere in una cella
    XL.Range("A1").Value = "1"
    XL.Range("A2").Value = "12"
    'xl.Range("A1").Font.Size = Size 'grandezza del Font(es 10)
    'XL.Range("A1").Font.Bold = Bold    'grassetto(true o false)
    'per fare calcolare una somma
    XL.Range("B30").Formula = "=sum(a1:a2)"
    'dimensionamento del foglio
    'XL.ActiveSheet.PageSetup.Orientation = xlPortrait
    'anteprima di stampa
    'XL.Activesheet.P.PRINTPREVIEW
    'stampa
    XL.Activesheet.PrintOut    'stampa
    'operazioni di chiusura del foglio
    XL.ActiveWorkbook.Close False
    XL.Quit

End Sub

and here wath i have maked in vba:

Code: Select all

Option Explicit
Dim CON As ADODB.Connection, RS As ADODB.Recordset, SQL As String, GIORNO As Date, DXSX As String, strDBRows_ESTRAI() As Variant
Const STRDBPATH = "C:\DATABASE\HOTEL.mdb"
Dim WS As Worksheet
Public Sub APRI_CONN()
    
    If CON Is Nothing Then
        Set CON = New ADODB.Connection
        With CON
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Open STRDBPATH
        End With
    End If
    
    Call APRI_EXCEL
    
End Sub
Private Sub APRI_EXCEL()
    
    GIORNO = "01/08/2021"
    DXSX = "S"
    
    Dim K As Long, NR As Long
    Set WS = Worksheets("REPORT")
    
    WS.Range("B2:AZ51").ClearContents
    
    SQL = "SELECT FILA, NUMERO FROM OMBRELLONI WHERE OMBRELLONI.GIORNO=#" & Format(GIORNO, "MM/DD/YYYY") & "# AND DS='" & DXSX & "' "
    
    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
    RS.Open Source:=SQL, _
        ActiveConnection:=CON, _
        CursorType:=adOpenForwardOnly, _
        LockType:=adLockReadOnly
    RS.Sort = ("FILA,NUMERO")
    
    RS.MoveFirst
    Erase strDBRows_ESTRAI()
    strDBRows_ESTRAI = RS.GetRows()
    RS.Close
    Set RS = Nothing
    
    With WS
    Application.ScreenUpdating = False
        For K = 0 To UBound(strDBRows_ESTRAI, 2)
            NR = NR + 1
            .Cells(strDBRows_ESTRAI(0, K) + 1, strDBRows_ESTRAI(1, K) + 1) = "X"
            .Cells(strDBRows_ESTRAI(0, K) + 1, 52) = .Cells(strDBRows_ESTRAI(0, K) + 1, 52) + 1
        Next K
        Application.ScreenUpdating = True
    End With
    
End Sub

no idea to move the vba code to vb6 code...

i know is a strong work... tks for all.

note:
the part of code refered a database connection i know:-)

SpeakEasy · Post by **SpeakEasy** » 27 Oct 2021, 18:33

Code: Select all

Private Sub APRI_EXCEL()
    
    GIORNO = "01/08/2021"
    DXSX = "S"

    Dim K As Long, NR As Long
    Set WS = CreateObject("Excel.Application").Workbooks.Open(FileName:="C:\Lavori_Vb6\HOTEL\TEMPLATE.XLS", Editable:=True).Sheets("REPORT")
    
    WS.Range("B2:AZ51").ClearContents
    
    SQL = "SELECT FILA, NUMERO FROM OMBRELLONI WHERE OMBRELLONI.GIORNO=#" & Format(GIORNO, "MM/DD/YYYY") & "# AND DS='" & DXSX & "' "
    
    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
    RS.Open Source:=SQL, _
        ActiveConnection:=CON, _
        CursorType:=adOpenForwardOnly, _
        LockType:=adLockReadOnly
    RS.Sort = ("FILA,NUMERO")
    
    RS.MoveFirst
    Erase strDBRows_ESTRAI()
    strDBRows_ESTRAI = RS.GetRows()
    RS.Close
    Set RS = Nothing
    
    With WS
        .Application.ScreenUpdating = False
        For K = 0 To UBound(strDBRows_ESTRAI, 2)
            NR = NR + 1
            .Cells(strDBRows_ESTRAI(0, K) + 1, strDBRows_ESTRAI(1, K) + 1) = "X"
            .Cells(strDBRows_ESTRAI(0, K) + 1, 52) = .Cells(strDBRows_ESTRAI(0, K) + 1, 52) + 1
        Next K
        .Application.ScreenUpdating = True
    End With
    
End Sub

Post by **HansV** » 27 Oct 2021, 18:35

Try this (basically the same as the code posted by SpeakEasy):

Code: Select all

Option Explicit

Dim CON As ADODB.Connection
Dim RS As ADODB.Recordset
Dim SQL As String
Dim GIORNO As Date
Dim DXSX As String
Dim strDBRows_ESTRAI() As Variant
Dim XL As Object
Dim xlWb As Object
Dim WS As Object
Dim sFile As Stream
Const STRDBPATH = "C:\DATABASE\HOTEL.mdb"

Public Sub APRI_CONN()
    If CON Is Nothing Then
        Set CON = New ADODB.Connection
        With CON
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Open STRDBPATH
        End With
    End If

    Call APRI_EXCEL
End Sub

Private Sub APRI_EXCEL()
    Dim K As Long

    Set XL = CreateObject("Excel.Application")
    sFile = "C:\Lavori_Vb6\HOTEL\TEMPLATE.XLS"
    Set xlWb = XL.Workbooks.Open(FileName:=sFile)
    Set WS = xlWb.Worksheets("REPORT")
    WS.Range("B2:AZ51").ClearContents

    GIORNO = "01/08/2021"
    DXSX = "S"
    SQL = "SELECT FILA, NUMERO FROM OMBRELLONI WHERE OMBRELLONI.GIORNO=#" & Format(GIORNO, "MM/DD/YYYY") & "# AND DS='" & DXSX & "' "

    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
    RS.Open Source:=SQL, _
        ActiveConnection:=CON, _
        CursorType:=adOpenForwardOnly, _
        LockType:=adLockReadOnly
    RS.Sort = "FILA,NUMERO"
    RS.MoveFirst

    Erase strDBRows_ESTRAI()
    strDBRows_ESTRAI = RS.GetRows()
    RS.Close
    Set RS = Nothing

    Application.ScreenUpdating = False
    With WS
        For K = 0 To UBound(strDBRows_ESTRAI, 2)
            .Cells(strDBRows_ESTRAI(0, K) + 1, strDBRows_ESTRAI(1, K) + 1) = "X"
            .Cells(strDBRows_ESTRAI(0, K) + 1, 52) = .Cells(strDBRows_ESTRAI(0, K) + 1, 52) + 1
        Next K
    End With
    Application.ScreenUpdating = True
End Sub

sal21 · Post by **sal21** » 27 Oct 2021, 20:47

HansV wrote: ↑

27 Oct 2021, 18:35

Try this (basically the same as the code posted by SpeakEasy):

Code: Select all

Option Explicit

Dim CON As ADODB.Connection
Dim RS As ADODB.Recordset
Dim SQL As String
Dim GIORNO As Date
Dim DXSX As String
Dim strDBRows_ESTRAI() As Variant
Dim XL As Object
Dim xlWb As Object
Dim WS As Object
Dim sFile As Stream
Const STRDBPATH = "C:\DATABASE\HOTEL.mdb"

Public Sub APRI_CONN()
    If CON Is Nothing Then
        Set CON = New ADODB.Connection
        With CON
            .Provider = "Microsoft.Jet.OLEDB.4.0"
            .Open STRDBPATH
        End With
    End If

    Call APRI_EXCEL
End Sub

Private Sub APRI_EXCEL()
    Dim K As Long

    Set XL = CreateObject("Excel.Application")
    sFile = "C:\Lavori_Vb6\HOTEL\TEMPLATE.XLS"
    Set xlWb = XL.Workbooks.Open(FileName:=sFile)
    Set WS = xlWb.Worksheets("REPORT")
    WS.Range("B2:AZ51").ClearContents

    GIORNO = "01/08/2021"
    DXSX = "S"
    SQL = "SELECT FILA, NUMERO FROM OMBRELLONI WHERE OMBRELLONI.GIORNO=#" & Format(GIORNO, "MM/DD/YYYY") & "# AND DS='" & DXSX & "' "

    Set RS = New ADODB.Recordset
    RS.CursorLocation = adUseClient
    RS.Open Source:=SQL, _
        ActiveConnection:=CON, _
        CursorType:=adOpenForwardOnly, _
        LockType:=adLockReadOnly
    RS.Sort = "FILA,NUMERO"
    RS.MoveFirst

    Erase strDBRows_ESTRAI()
    strDBRows_ESTRAI = RS.GetRows()
    RS.Close
    Set RS = Nothing

    Application.ScreenUpdating = False
    With WS
        For K = 0 To UBound(strDBRows_ESTRAI, 2)
            .Cells(strDBRows_ESTRAI(0, K) + 1, strDBRows_ESTRAI(1, K) + 1) = "X"
            .Cells(strDBRows_ESTRAI(0, K) + 1, 52) = .Cells(strDBRows_ESTRAI(0, K) + 1, 52) + 1
        Next K
    End With
    Application.ScreenUpdating = True
End Sub

Tto the and of loop, i need to printout the sheet TEMPLATE, destroyed all object, close Excel, and close the workbook without save...

Post by **HansV** » 27 Oct 2021, 21:16

You can call PRINT_REPORT at the end of APRI_EXCEL.

SpeakEasy · Post by **SpeakEasy** » 27 Oct 2021, 23:05

HansV wrote: ↑
27 Oct 2021, 18:35
Try this (basically the same as the code posted by SpeakEasy)

And my code in turn was 100% sal21's code with 1 single line added (and two periods)

sal21 · Post by **sal21** » 28 Oct 2021, 06:04

HansV wrote: ↑
27 Oct 2021, 21:16
You can call PRINT_REPORT at the end of APRI_EXCEL.

TKS.

But before to print i need to insert in the head and bottom of print report, wath you see in image...

note:
the date 28/10/2021 is store in a var date, MYDATA

Post by **HansV** » 28 Oct 2021, 06:57

Add these lines:

Code: Select all

    WS.PageSetup.CenterHeader = "REPORT OMBRELLONI DEL: " & Format(MYDATA, "dd/mm/yyyy")
    WS.PageSetup.LeftFooter = "STAMPATO IL: " & Format(MYDATA, "dd/mm/yyyy")

sal21 · Post by **sal21** » 28 Oct 2021, 13:59

HansV wrote: ↑

28 Oct 2021, 06:57

Add these lines:

Code: Select all

    WS.PageSetup.CenterHeader = "REPORT OMBRELLONI DEL: " & Format(MYDATA, "dd/mm/yyyy")
    WS.PageSetup.LeftFooter = "STAMPATO IL: " & Format(MYDATA, "dd/mm/yyyy")

TKS. as usual.

but possible to intercept when the print job is finished and the printer not have error?

Post by **HansV** » 28 Oct 2021, 14:05

Not as far as I know.

Post by **Leif** » 28 Oct 2021, 16:00

sal21 wrote: ↑
28 Oct 2021, 13:59
but possible to intercept when the print job is finished and the printer not have error?

Just a thought - can you query the print queue?

sal21 · Post by **sal21** » 28 Oct 2021, 16:36

Leif wrote: ↑
28 Oct 2021, 16:00

sal21 wrote: ↑
28 Oct 2021, 13:59
but possible to intercept when the print job is finished and the printer not have error?
Just a thought - can you query the print queue?

yes.

Eileen's Lounge

USE EXCEL IN VB6

USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6

Re: USE EXCEL IN VB6