Export VB6 MSHflexgri to Excel issue

Posted on 2011-05-05
Last Modified: 2012-05-11
Hello all

I'm trying to export my grid from column 0 but it only export from column 1 to the end.

Do you know why?

Thanks again for your help.

Private Sub perdc_Click()
Dim i As Long, j As Long, Rw As Long, Cl As Long
    Dim oXlObj As Excel.Application
    Dim oXlWbObj As Excel.Workbook
    Dim MyArray() As String
    Dim found As Boolean
    Rw = 0
    With MSHFlexGrid2
        ReDim Preserve MyArray(.Rows - 1, 10)
        '~~> Get Headers
        For i = 1 To .Cols - 1
        On Error Resume Next
            MyArray(0, i) = MSHFlexGrid2.TextMatrix(0, i)
        Next i
        '~~> Loop through the rows
        For i = 1 To .Rows - 1
            If .TextMatrix(i, 3) <> "" Then
                found = True
                Rw = Rw + 1
                Cl = 0
                For j = 1 To .Cols - 1
                    MyArray(Rw, j) = MSHFlexGrid2.TextMatrix(i, j)
                    Cl = Cl + 1
                Next j
            End If
        Next i
    End With
    '~~> If instance found then get Excel ready for export
    If found = True Then
        Set oXlObj = New Excel.Application
        '~~> Add a new woorkbook
        Set oXlWbObj = oXlObj.Workbooks.Add
        For i = 0 To UBound(MyArray)
            For j = 1 To 15
                oXlWbObj.Sheets(1).Cells(i + 1, j).Value = MyArray(i, j)
            Next j
        Next i
         oXlObj.ActiveWorkbook.ActiveSheet.Range("A1:J1").Interior.Color = RGB(205, 197, 191)
       oXlObj.ActiveWorkbook.ActiveSheet.Columns("A:A").ColumnWidth = 8
        oXlObj.ActiveWorkbook.ActiveSheet.Columns("A:A").HorizontalAlignment = xlLeft
         oXlObj.ActiveWorkbook.ActiveSheet.Columns("A:A").Text = Format(oXlObj.ActiveWorkbook.ActiveSheet.Columns("A:A"), "00")
          oXlObj.ActiveWorkbook.ActiveSheet.Columns("B:B").ColumnWidth = 12
           oXlObj.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
            oXlObj.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 17
             oXlObj.ActiveWorkbook.ActiveSheet.Columns("C:C").HorizontalAlignment = xlLeft
              oXlObj.ActiveWorkbook.ActiveSheet.Columns("D:D").ColumnWidth = 11
               oXlObj.ActiveWorkbook.ActiveSheet.Columns("D:D").HorizontalAlignment = xlLeft
                oXlObj.ActiveWorkbook.ActiveSheet.Columns("E:E").ColumnWidth = 8
                 oXlObj.ActiveWorkbook.ActiveSheet.Columns("E:E").HorizontalAlignment = xlLeft
                oXlObj.ActiveWorkbook.ActiveSheet.Columns("F:F").ColumnWidth = 11
               oXlObj.ActiveWorkbook.ActiveSheet.Columns("F:F").HorizontalAlignment = xlLeft
              oXlObj.ActiveWorkbook.ActiveSheet.Columns("G:G").ColumnWidth = 13
             oXlObj.ActiveWorkbook.ActiveSheet.Columns("G:G").HorizontalAlignment = xlLeft
            oXlObj.ActiveWorkbook.ActiveSheet.Columns("H:H").ColumnWidth = 13
           oXlObj.ActiveWorkbook.ActiveSheet.Columns("H:H").HorizontalAlignment = xlLeft
          oXlObj.ActiveWorkbook.ActiveSheet.Columns("I:I").ColumnWidth = 22
         oXlObj.ActiveWorkbook.ActiveSheet.Columns("I:I").HorizontalAlignment = xlLeft
        oXlObj.ActiveWorkbook.ActiveSheet.Columns("J:J").ColumnWidth = 22
       oXlObj.ActiveWorkbook.ActiveSheet.Columns("J:J").HorizontalAlignment = xlLeft

oXlObj.ActiveWindow.FreezePanes = True

        oXlObj.Visible = True
    End If
    'End If
End Sub

Open in new window

Question by:Wilder1626
    LVL 5

    Accepted Solution

    You try this one:

    Private Sub FlexToExcel()
    Dim xlObject    As Excel.Application
    Dim xlWB        As Excel.Workbook
        Set xlObject = New Excel.Application

        'This Adds a new woorkbook, you could open the workbook from file also
        Set xlWB = xlObject.Workbooks.Add
        Clipboard.Clear 'Clear the Clipboard
        With MSFlexGrid1
            'Select Full Contents (You could also select partial content)
            .Col = 0               'From first column
            .Row = 0               'From first Row (header)
            .ColSel = .Cols - 1    'Select all columns
            .RowSel = .Rows - 1    'Select all rows
            Clipboard.SetText .Clip 'Send to Clipboard
        End With
        With xlObject.ActiveWorkbook.ActiveSheet
            .Range("A1").Select 'Select Cell A1 (will paste from here, to different cells)
            .Paste              'Paste clipboard contents
        End With
        ' This makes Excel visible
        xlObject.Visible = True
    End Sub
    LVL 11

    Author Closing Comment


    Thanks, i will take that one.

    Featured Post

    Top 6 Sources for Identifying Threat Actor TTPs

    Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

    Join & Write a Comment

    Suggested Solutions

    Title # Comments Views Activity
    Vb6 rich textbox tab 10 53
    multiple  selections in listbox no ctl 2 37 Listview 9 67 2008 2 39
    I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
    This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
    Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
    This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

    728 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    17 Experts available now in Live!

    Get 1:1 Help Now