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

Wilder1626
Wilder1626 used Ask the Experts™
on
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

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Try YourFormName.Show vbModal
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Thanks, I will give it a try right now. Be back soon.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Older than dirt
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
Here's a better idea. After line 37 add

   
wksOut.Protect UserInterfaceOnly:=True

Open in new window

Thank you so much. That did the job pretty good without me having to wait until all extracted in Excel.
Martin LissOlder than dirt
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
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

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial