VB6 much slower than Excel VBA

  • Thread starter Thread starter Fiona
  • Start date Start date
F

Fiona

I would like to recreate a collection of VBA forms in VB6 but the
result runs very slowly when ever I change the contents of a text box
on the VB6 version.

I've tried early binding (not sure if its quite right) seems to be
different ways ?

Below are 2 sets of code, the first the VB form, second the Excel VBA
form.
The VB6 form works but has a slight hang whenever you enter a value.

Any help gratefully recieved.



VB6
----
Declarations
-------------


Dim ObjExcel As Excel.Application

------------------------------------------

Private Sub Form Load

Set ObjExcel = New Excel.Application
ObjExcel.Workbooks.Open (Path & "\" & MyFolder & "\" & MyFile)
ObjExcel.Visible = False

End Sub

--------------------------------------------------

Private Sub CboShops_Change()
X = CboShops.ListIndex + 8
h = CboShops.ListIndex + 9


TxtD.Text = Worksheets(1).Cells(X, 3).Text
TxtDT.Text = Worksheets(1).Cells(X, 4).Text
LblDTP.Caption = Worksheets(1).Cells(X, 5).Text
TxtDY.Text = Worksheets(1).Cells(X, 6).Text
LblDYP.Caption = Worksheets(1).Cells(X, 7).Text
TxtB.Text = Worksheets(1).Cells(X, 8).Text
TxtBT.Text = Worksheets(1).Cells(X, 9).Text
LblBTP.Caption = Worksheets(1).Cells(X, 10).Text
TxtBY.Text = Worksheets(1).Cells(X, 11).Text
LblBYP.Caption = Worksheets(1).Cells(X, 12).Text
TxtC.Text = Worksheets(1).Cells(X, 13).Text
TxtCT.Text = Worksheets(1).Cells(X, 14).Text
LblCTP.Caption = Worksheets(1).Cells(X, 15).Text
TxtCY.Text = Worksheets(1).Cells(X, 16).Text
LblCYP.Caption = Worksheets(1).Cells(X, 17).Text
LblT.Caption = Worksheets(1).Cells(X, 18).Text
LblTT.Caption = Worksheets(1).Cells(X, 19).Text
LblTTP.Caption = Worksheets(1).Cells(X, 20).Text
LblTY.Caption = Worksheets(1).Cells(X, 21).Text
LblTYP.Caption = Worksheets(1).Cells(X, 22).Text



TxtH.Text = Worksheets(2).Cells(h, 4).Text
TxtNH.Text = Worksheets(2).Cells(h, 5).Text

End Sub

------------------------------------------------------------

Private Sub TxtB_Change()
X = CboShops.ListIndex + 8
If X <> 26 Then
If IsNumeric(TxtB.Text) = False And TxtB.Text <> "" Then
MsgBox "Numbers Only Please", vbExclamation + vbOKOnly
TxtB.Text = ""
TxtB.SetFocus
Else
Worksheets(1).Cells(X, 8).Value = TxtB.Text
CboShops_Change
End If
End If
End Sub

***********************************************************************

***********************************************************************

Excel App
---------------
Workbook code:
---------------

Private Sub Workbook_Open()

FrmArea.Show

End Sub

----------------------------------------------
User Form Code:
---------------
Private Sub CboShops_Change()
X = CboShops.ListIndex + 8
h = CboShops.ListIndex + 9


TxtD.Text = Worksheets(1).Cells(X, 3).Text
TxtDT.Text = Worksheets(1).Cells(X, 4).Text
LblDTP.Caption = Worksheets(1).Cells(X, 5).Text
TxtDY.Text = Worksheets(1).Cells(X, 6).Text
LblDYP.Caption = Worksheets(1).Cells(X, 7).Text
TxtB.Text = Worksheets(1).Cells(X, 8).Text
TxtBT.Text = Worksheets(1).Cells(X, 9).Text
LblBTP.Caption = Worksheets(1).Cells(X, 10).Text
TxtBY.Text = Worksheets(1).Cells(X, 11).Text
LblBYP.Caption = Worksheets(1).Cells(X, 12).Text
TxtC.Text = Worksheets(1).Cells(X, 13).Text
TxtCT.Text = Worksheets(1).Cells(X, 14).Text
LblCTP.Caption = Worksheets(1).Cells(X, 15).Text
TxtCY.Text = Worksheets(1).Cells(X, 16).Text
LblCYP.Caption = Worksheets(1).Cells(X, 17).Text
LblT.Caption = Worksheets(1).Cells(X, 18).Text
LblTT.Caption = Worksheets(1).Cells(X, 19).Text
LblTTP.Caption = Worksheets(1).Cells(X, 20).Text
LblTY.Caption = Worksheets(1).Cells(X, 21).Text
LblTYP.Caption = Worksheets(1).Cells(X, 22).Text



TxtH.Text = Worksheets(2).Cells(h, 4).Text
TxtNH.Text = Worksheets(2).Cells(h, 5).Text

End Sub

----------------------------------------------------

Private Sub TxtB_Change()
X = CboShops.ListIndex + 8
If X <> 26 Then
If IsNumeric(TxtB.Text) = False And TxtB.Text <> "" Then
MsgBox "Numbers Only Please", vbExclamation + vbOKOnly
TxtB.Text = ""
TxtB.SetFocus
Else
Worksheets(1).Cells(X, 8).Value = TxtB.Text
CboShops_Change
End If
End If
End Sub
 
Fiona,

Try creating a Workbook object and Worksheet objects and reference through
them. For example

Dim ObjExcel As Excel.Application
Dim objWB As Excel.Workbook
Dim objWS1 As Excel.Worksheet
Dim objWS2 As Excel.Worksheet
------------------------------------------

Private Sub Form Load

Set ObjExcel = New Excel.Application
Set objWB = ObjExcel.Workbooks.Open(Path & "\" & MyFolder & "\" &
MyFile)
Set objWS1 = objWB.Worksheets(1)
Set objWS2 = objWB.Worksheets(2)
ObjExcel.Visible = False

End Sub

--------------------------------------------------

Private Sub CboShops_Change()
X = CboShops.ListIndex + 8
h = CboShops.ListIndex + 9

With objWS1
TxtD.Text = .Cells(X, 3).Text
TxtDT.Text = .Cells(X, 4).Text
LblDTP.Caption = .Cells(X, 5).Text
TxtDY.Text = .Cells(X, 6).Text
LblDYP.Caption = .Cells(X, 7).Text
TxtB.Text = .Cells(X, 8).Text
TxtBT.Text = .Cells(X, 9).Text
LblBTP.Caption = .Cells(X, 10).Text
TxtBY.Text = .Cells(X, 11).Text
LblBYP.Caption = .Cells(X, 12).Text
TxtC.Text = .Cells(X, 13).Text
TxtCT.Text = .Cells(X, 14).Text
LblCTP.Caption = .Cells(X, 15).Text
TxtCY.Text = .Cells(X, 16).Text
LblCYP.Caption = .Cells(X, 17).Text
LblT.Caption = .Cells(X, 18).Text
LblTT.Caption = .Cells(X, 19).Text
LblTTP.Caption = .Cells(X, 20).Text
LblTY.Caption = .Cells(X, 21).Text
LblTYP.Caption = .Cells(X, 22).Text
End With


TxtH.Text = objWS2.Cells(h, 4).Text
TxtNH.Text = objWS2.Cells(h, 5).Text

End Sub


Haven't tested it but that is how I would do it.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Thanks Bob,

Haven't had chance to try this out properly yet, I have a number of
versions of this in VB6 which I droppped in favour of just using Excel
& VBA, so I need to re-visit them again :o)

The referencing looks much better, and hopefully to Dim the worksheets
as well as the workbook should help.
 
Back
Top