EXPORT msflexgrid into excel sheet

[sal21]

I need only a part for looping

MY poor code:

Code: Select all

Private Sub Command2_Click()

    If Me.LNRAR.Caption > "" Then

        DATANOW = Format(CDate(Now), "YYYYMMDD")

        Set OBJXL = CreateObject("Excel.Application")
        Set WBXL = OBJXL.Workbooks.Open(STRPATHXLS)
        OBJXL.Visible = False

        Set WSXL = WBXL.Sheets("REPORT")

        Dim R As Long, C As Long, NUMC As Integer

        With Me.MSFlexGrid1

            NUMC = .Cols - 1

            For R = 1 To .Rows - 1

                For C = 1 To NUMC

                    Debug.Print .TextMatrix(R, C)

                Next C

            Next R

        End With

        WBXL.SaveAs STRPATHXLSFILE & "REPORT_" & DATANOW & ".xls"
        WBXL.Close SaveChanges:=False

        Set WBXL = Nothing
        Set WSXL = Nothing
        
        OBJXL.Quit
        Set OBJXL = Nothing

    Else

        Beep
        Me.LAZIONI.Caption = "NESSUN DATO DA ESPORTARE!"
        DoEvents
        Sleep (1500)
        Me.LAZIONI.Caption = ""

    End If

End Sub

note:
the workbook is in c:\mydir\
the sheet is named report
start the copy from column 1 of msflexgrid
Public OBJXL As Object, WBXL As Object, WSXL As Object

[HansV]

Change the line

Code: Select all

                    Debug.Print .TextMatrix(R, C)

to

Code: Select all

                   WSXL.Cells(R, C).Value = .TextMatrix(R, C)

[sal21]

Change the line

Code: Select all

                    Debug.Print .TextMatrix(R, C)

to

Code: Select all

                   WSXL.Cells(R, C).Value = .TextMatrix(R, C)

tks! work

But i can use in vb6

Application.ScreenUpdating = False
...
Application.ScreenUpdating = True

[HansV]

Since OBJXL is your Excel.Application object, use

OBJXL.ScreenUpdating = False
...
OBJXL.ScreenUpdating = True

[sal21]

Since OBJXL is your Excel.Application object, use

OBJXL.ScreenUpdating = False
...
OBJXL.ScreenUpdating = True

Tks!

[sal21]

Change the line

Code: Select all

                    Debug.Print .TextMatrix(R, C)

to

Code: Select all

                   WSXL.Cells(R, C).Value = .TextMatrix(R, C)

i need to save as the original workbook with new name and close it without save it

Is correct thi part of code?

Code: Select all

...
WBXL.SaveAs STRPATHXLSFILE & "REPORT_" & DATANOW & ".xls"
        WBXL.Close SaveChanges:=False

        Set WBXL = Nothing
        Set WSXL = Nothing

        OBJXL.Quit
        Set OBJXL = Nothing
...

why, ... i cannot cut and past the original workbook???

[HansV]

Do you have other code that refers to the workbook or its worksheet?

[sal21]

Do you have other code that refers to the workbook or its worksheet?

my last complete code:

Code: Select all

Private Sub Command2_Click()

    If Me.LNRAR.Caption > "" Then
    
        Me.Text1.SetFocus
    
    Dim TOTRG As Long
    
        Screen.MousePointer = vbHourglass

        Me.LAZIONI.Caption = "EXPORT DATI IN EXCEL!..."
        DoEvents

        DATANOW = Format(CDate(Now), "YYYYMMDD_HHMMSS")

        Set OBJXL = CreateObject("Excel.Application")
        Set WBXL = OBJXL.Workbooks.Open(STRPATHXLS)
        OBJXL.Visible = False

        Set WSXL = WBXL.Sheets("REPORT")

        Dim R As Long, C As Long, NUMC As Integer
        
        Me.ProgressBar1.Value = 0

        With Me.MSFlexGrid1
        
        TOTRG = .Rows - 1

            NUMC = .Cols - 1

            OBJXL.ScreenUpdating = False

            For R = 1 To .Rows - 1

                DoEvents

                For C = 1 To NUMC

                    WSXL.Cells(R + 1, C).Value = .TextMatrix(R, C)

                Next C
                
                Me.ProgressBar1.Value = (R / TOTRG) * 100

            Next R

            OBJXL.ScreenUpdating = True
            
            Me.ProgressBar1.Value = 0

        End With

        WBXL.SaveAs STRPATHXLSFILE & "REPORT_" & DATANOW & ".xls"
        WBXL.Close SaveChanges:=False

        Set WBXL = Nothing
        Set WSXL = Nothing

        OBJXL.Quit
        Set OBJXL = Nothing

        Me.LAZIONI.Caption = "FINE EXPORT DATI IN EXCEL"
        DoEvents
        Sleep (2000)
        Me.LAZIONI.Caption = ""
        Me.Text1.SetFocus
        
        Screen.MousePointer = vbDefault

    Else

        Beep
        Me.LAZIONI.Caption = "NESSUN DATO DA ESPORTARE!"
        DoEvents
        Sleep (1500)
        Me.LAZIONI.Caption = ""

    End If

End Sub

note:

public const in a module

...
Public Const STRPATHXLS = "C:\DIEGO_VB6\FERRAMENTA\SERVIZIO\REPORT.XLS"
Public Const STRPATHXLSFILE = "C:\DIEGO_VB6\FERRAMENTA\XLS_FILE\"
Public OBJXL As Object, WBXL As Object, WSXL As Object

[HansV]

I'm afraid I don't see what could cause the error, sorry. Does the problem persist if you restart your computer?

[sal21]

Change the line

Code: Select all

                    Debug.Print .TextMatrix(R, C)

to

Code: Select all

                   WSXL.Cells(R, C).Value = .TextMatrix(R, C)

hummmm...

i need to loop all rows only if in column 0 have a Image2...

i feel the column 0 with:
...
.Col = 0
.Row = I + 1
Set .CellPicture = Me.Image2.Picture
...

note:
see my first image in the post

[HansV]

I cannot test this. Perhaps something like

Code: Select all

                   .Col = 0
                   .Row = R
                   If Not .CellPicture Is Nothing Then
                       WSXL.Cells(R, C).Value = .TextMatrix(R, C)
                   End If

[sal21]

I cannot test this. Perhaps something like

Code: Select all

                   .Col = 0
                   .Row = R
                   If Not .CellPicture Is Nothing Then
                       WSXL.Cells(R, C).Value = .TextMatrix(R, C)
                   End If

OK

but i can have also image1 or image2

i need to test only is the image in column 0 is named image2

[HansV]

I don't know, sorry.

[SpeakEasy]

>test only is the image in column 0 is named image2

Even if you set a Picture using LoadPicture the Picture object does NOT retain the filename for later use, I am afraid.

However, you can use some underlying GDI properties. Basically if you copy a Picture from one object to another, the HANDLE property stays the same.

Now, given your statement that you use

Set .CellPicture = Me.Image2.Picture

it looks like you have your Image1 and Image2 as sources for CellPicture on the form - so you can do the following tests:

If .CellPicture.Handle = Me.Image2.Picture.Handle

or

If .CellPicture.Handle = Me.Image1.Picture.Handle

[sal21]

>test only is the image in column 0 is named image2

Even if you set a Picture using LoadPicture the Picture object does NOT retain the filename for later use, I am afraid.

However, you can use some underlying GDI properties. Basically if you copy a Picture from one object to another, the HANDLE property stays the same.

Now, given your statement that you use

Set .CellPicture = Me.Image2.Picture

it looks like you have your Image1 and Image2 as sources for CellPicture on the form - so you can do the following tests:

If .CellPicture.Handle = Me.Image2.Picture.Handle

or

If .CellPicture.Handle = Me.Image1.Picture.Handle

tks