Link to home
Start Free TrialLog in
Avatar of Wilder1626
Wilder1626Flag for Canada

asked on

VB6 - Cannot type when doing an extract from MSHFlexgrid to Excel


I'm always facing some problem when i want to extract from MSHFlexgrid to Excel. Not that it doesn't extract, it's just that during the process, if i open another excel file or if i type, it override what's extracting from the MSHFlexgrid to Excel.

How can I isolate the extraction, while continuing to do something else?

Here is the full extract to excel macro:
Dim xlObj As Object    'New Excel.Application -- only used with Excel reference
    Dim wkbOut As Object   'Excel.Workbook
    Dim wksOut As Object   'Excel.Worksheet
    Dim rngOut As Object   'Excel.Range
    Dim sngStart As Single    'forperformance measurement
    Dim start_time As Long
    Dim end_time As Long
    Dim total_time As Long
    Dim FileNm As Variant

    On Error Resume Next

    'Save file to
    With CommonDialog1
        .DialogTitle = "Audit analysis..."
        .fileName = flat_file_name.Text & " conversion " & Format(Date, "mmmm dd, yyyy")
        .CancelError = True  '<--moved
        '.Filter = "Excel Files (*.xls)|*.xls"
        .Filter = "Spreadsheet Files (*.xls)|*.xls| 2k7 Excel Files (*.xlsx)|*.xlsx"

        If Err.Number = 32755 Then
            MsgBox "not saved - user pressed cancel or closed the dialog"
            Exit Sub
            FileNm = .fileName
            path_link = FileNm & ".xls"
        End If

    End With

    'output to Excel workbook
    ' lblStatus.Caption = "Begin Excel Data Export"
    Set xlObj = CreateObject("Excel.Application")
    Set wkbOut = xlObj.Workbooks.Add
    Set wksOut = wkbOut.Worksheets("Sheet1")  'can skip this step
    Set rngOut = wksOut.Range("A2")           'by replacing with wkbOut.Worksheets("Sheet1").Range("A1")

    Me.MousePointer = vbHourglass
    Me.Enabled = False

    xlObj.ScreenUpdating = False
    xlObj.Calculation = -4135     '=xlCalculationManual

    'BulkLoad rngOut, sngData
    Clipboard.Clear    'Clear the Clipboard
    With MSHFlexGrid1
        .Col = 0
        .Row = 0
        .ColSel = .Cols - 1
        .RowSel = .Rows - 1
        Clipboard.SetText .Clip
    End With
    With xlObj.ActiveWorkbook.ActiveSheet
        .Range("A2:AF2").Interior.Color = RGB(205, 197, 191)
        .Columns("A:AF").NumberFormat = "@"
       ' .Columns("B:AF").HorizontalAlignment = xlCenter
       ' .Columns("F:AF").WrapText = True
       ' .Columns("A:AF").Borders.LineStyle = xlContinuous
        .Range("A1").HorizontalAlignment = xlLeft
        .Range("A1") = flat_file_name.Text & " Excel format " & Format(Date, "mmmm dd, yyyy")
        .Range("A1").HorizontalAlignment = xlLeft
        .Range("A1").Font.Bold = True
        .Range("A1").Font.Size = 20
        ActiveWindow.FreezePanes = True
        Rows("2:8000").RowHeight = 15

        .Range("B1:D1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("E1:F1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("G1:H1").HorizontalAlignment = xlCenterAcrossSelection

    End With

    xlObj.ActiveWorkbook.SaveAs FileNm

    xlObj.Calculation = -4105     '=xlCalculationAutomatic
    xlObj.ScreenUpdating = True
    xlObj.Visible = True

    Set rngOut = Nothing
    Set wksOut = Nothing
    Set wkbOut = Nothing
    Set xlObj = Nothing

Open in new window

Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Try YourFormName.Show vbModal
If that doesn't work then try code like this that I found on the web which will restrict the cursor to your form..
Private Type RECT 
    left As Long 
    top As Long 
    right As Long 
    bottom As Long 
End Type 
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetDesktopWindow Lib "user32.dll" () As Long 
Private Sub cmdClip_Click() 
' Confines the cursor temporarily to inside of Form1
Dim r As RECT ' confinement rectangle 
Dim retval As Long ' return value 
retval = GetWindowRect(Form1.hwnd, r) ' put window's coordinates into r 
retval = ClipCursor(r) ' confine the cursor to the boundries defined in rEnd Sub 
End Sub 
Private Sub cmdUnclip_Click() 
' Unconfine the cursor (actually...confine it to the size of the desktop)
Dim r As RECT, retval As Long 
Dim deskhWnd As Long ' the handle of the desktop window 
deskhWnd = GetDesktopWindow() ' get handle of the desktop window 
retval = GetWindowRect(deskhWnd, r) ' put window's coordinates into r 
retval = ClipCursor(r) ' "confine" the cursor to the entire screen 
End Sub

Open in new window

Avatar of Wilder1626


Thanks, I will give it a try right now. Be back soon.
Avatar of Martin Liss
Martin Liss
Flag of United States of America image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thank you so much. That did the job pretty good without me having to wait until all extracted in Excel.
You're welcome and I'm glad I was able to help.

If you expand the “Full Biography” section of my profile you'll find links to some articles I've written that may interest you.

Marty - Microsoft MVP 2009 to 2016
              Experts Exchange MVE 2015
              Experts Exchange Top Expert Visual Basic Classic 2012 to 2016