asked on

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

Hi

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"
        .ShowSave


        If Err.Number = 32755 Then
            MsgBox "not saved - user pressed cancel or closed the dialog"
            Exit Sub
        Else
            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").Select
        .Range("A2:AF2").Interior.Color = RGB(205, 197, 191)
        .Columns("A:AF").NumberFormat = "@"
        .Paste
        .Columns("A:w").AutoFit
        .Columns("y:af").AutoFit
       ' .Columns("B:AF").HorizontalAlignment = xlCenter
       ' .Columns("F:AF").WrapText = True
       ' .Columns("A:AF").Borders.LineStyle = xlContinuous
        .Range("A1:M1").Merge
        .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
        .Range("C3").Select
        ActiveWindow.FreezePanes = True
        Rows("2:8000").RowHeight = 15


        .Range("B1:D1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("E1:F1").HorizontalAlignment = xlCenterAcrossSelection
        .Range("G1:H1").HorizontalAlignment = xlCenterAcrossSelection
        .Columns("AG").Delete
        .Rows("1").Delete


    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

Martin Liss

Try YourFormName.Show vbModal

Martin Liss

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

Wilder1626

ASKER

Thanks, I will give it a try right now. Be back soon.

ASKER CERTIFIED SOLUTION

Martin Liss

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Wilder1626

ASKER

Thank you so much. That did the job pretty good without me having to wait until all extracted in Excel.

Martin Liss

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