We help IT Professionals succeed at work.

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

Wilder1626
Wilder1626 asked
on
240 Views
Last Modified: 2017-03-11
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

Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018

Commented:
Try YourFormName.Show vbModal
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
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

CERTIFIED EXPERT

Author

Commented:
Thanks, I will give it a try right now. Be back soon.
Protect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
Most Valuable Expert 2017
Distinguished Expert 2018
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
CERTIFIED EXPERT

Author

Commented:
Thank you so much. That did the job pretty good without me having to wait until all extracted in Excel.
Martin LissProtect yourself and your loved ones. Stay home for the holidays.
CERTIFIED EXPERT
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

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions