• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• To enhance Excel's DBase Functions

To enhance Excel's DBase Functions

To enhance Excel's DBase Functions

Rate To enhance Excel's DBase Functions

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

  ' Lable(treeName)  Label(Height)   Label(Age)        Lable)Profit)
  '
  ' Textbox1(text) txtbox(numbers)  txtbox(numbers)  txtbox(numbers)
 ' 
  '  list1            list2           list3            list4
'
'    combobox                command click            combobox
'
'  cmd     txtbox(greater than)   txtbox(less than)  cmd(activate)
'


Public Excel As Excel.Application  ' This line is very important
Dim Worksheet1 As Worksheet
Dim tempsum As Double
Public VarList1Count As Integer   ' Allow other forms to know the
                                      'number of total records

Private Sub Command1_Click()
Set Excel = New Excel.Application
Set Workbook = Excel.Workbooks.Add
Excel.Visible = True
Set Worksheet1 = Workbook.ActiveSheet

Rem You will need 4 list boxes, 2 combo boxes 6 text boxes
Rem  4 lables  and 3 command buttons

Rem  **** Remember to use the shift+ enter for the actual
Rem  ***  Data base formula you choose to enter
Rem  ***  Go to MS Help you forgot about this
Rem ***  Make sure every box is filled in
Rem ***  Do not put zero values in
Rem *** Put numbers where numbers belong and text
Rem **  where text belongs
Rem ** and lastly this program is far from complete
Rem ** but is better than my original post

VarList1Count = List1.ListCount    '


Rem    Automate this and allow for many varibles in place of Trees '  etc.  Ex. AutoMake  Price  etc..
  '    '  you will also want to automate the labels at start up
'                               ' Via a start new progects dialog of 'course you will have to save all to a file

Worksheet1.Cells(1, 2) = "Trees": Cells(1, 3) = "Height": Cells(1, 4) = "Age": Cells(1, 5) = "Profit"

Worksheet1.Cells(7, 2) = "Trees": Cells(7, 3) = "Height": Cells(7, 4) = "Age": Cells(7, 5) = "Profit"

Worksheet1.Cells(2, 2) = Combo2.Text '  Select your tree

Rem the greater than sign will move column 3, 4 or 5  with the
Rem  users chosen item in the combo box

Rem I am trying to move the > with combo choice
tempv = Combo1.ListIndex + 3 ' Adjust for the indent of the Excel '        Data Table

Worksheet1.Cells(2, Combo1.ListIndex + 3) = ">" & Text5.Text


Worksheet1.Cells(2, 6) = "<" & Text6.Text    ' This is fixed at cell 2,6


For i = 0 To List1.NewIndex
Worksheet1.Cells(8 + i, 2) = List1.List(i) 'Current Index num in loop

Worksheet1.Cells(8 + i, 3) = List2.List(i)
Worksheet1.Cells(8 + i, 4) = List3.List(i)

Rem  Note you may not want to format this item
Rem you get a type mismatch error for zero entries ?

Worksheet1.Cells(8 + i, 5) = List4.List(i)     'Format(List4.List(i), "$###,###.##")
Next i

With Excel.Application.ActiveSheet

Rem   The User picks Height,Age or Profit
Rem    Next line enters this pick into the last cell in row 1

Worksheet1.Cells(1, 6) = Combo1.Text

End With


' Now you are ready to start your calculations in excel
'and return those variables to a vb interface

'Here the colon will give you problems

tempsum = 0

Rem Determine the sum of the number under the heading
Rem  That which user picks from combo1
Rem  on the Excel sheet that would be the sum of the range
Rem   B: something  ---> vb won't let me insert a colon directly
Rem in somehting like

'
For t = 8 To 8 + List1.NewIndex
tempsum = tempsum + Worksheet1.Cells(t, Combo1.ListIndex + 3)

Next t

Worksheet1.Cells(1, 8) = tempsum

Worksheet1.Cells(2, 8) = Combo1.ListIndex + 3

Worksheet1.Cells(2, 8) = " You current List count is "
Worksheet1.Cells(3, 8) = "=" & List1.ListCount


Worksheet1.Cells(4, 8) = " Re enter the formula below without the slash"
Worksheet1.Cells(5, 8) = "\=Daverage (B7:E7,""Height"",B1:F2)\"

Worksheet1.Cells(6, 8) = " and change the sample  from B7 to E7 + the  List count given above"
Rem  Example if the list count was 8 you should enter B7:E15
Worksheet1.Cells(7, 8) = " Use the same pattern for the other DBase formulas found at Insert/Function/Database"


End Sub

Private Sub Command2_Click()

Rem you need to add without repeat , finish this
Combo2.AddItem Text1.Text


List1.AddItem (Text1.Text)
List2.AddItem (Text2.Text)
List3.AddItem (Text3.Text)
List4.AddItem (Text4.Text)

Text1.SetFocus

End Sub

Private Sub Command3_Click()
'If List1.ListIndex = True Then
'List1.RemoveItem List1.ListIndex

'This does work but only for the _
item selected in List1 _
Note: Use the listIndex for RemoveItem Phrase
'********************
On Error GoTo Fixit

List1.RemoveItem List1.ListIndex
Fixit:
MsgBox ("You must select the item in the listbox to remove it")

'  Why do I get message box twice ?


Exit Sub




End Sub

Private Sub Form_Load()
Rem You will get error " User Definded type not definded
Rem  if you don't Go to Project / References/ Microsoft
Rem  Excel 9 Object Library
Rem You will get error 'Expected variable not Project if you
Rem don't use
Rem  Rem You will get error " User Definded type not definded
Rem  if you don't Go to Project / References/ Microsoft
Rem  Excel 9 Object Library
Rem You will get error 'Expected variable not Project if you
Rem don't use
Rem  Public Excel As Excel.Application in the Declarations

Rem  Note  You are using Working with Data Base info as a temp Ref

Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)

End Sub

Private Sub mnu_End_Click()
End
End Sub

Private Sub mnu_Exit_Click()
End
End Sub

Private Sub mnu_Show_All_Records_Click()
frmComList.Show

End Sub

Private Sub Text1_Click()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text2_Click()
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)
End Sub

Private Sub Text2_GotFocus()
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)
End Sub

Private Sub Text3_Click()
Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)
End Sub

Private Sub Text3_GotFocus()

Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)
End Sub

Private Sub Text4_Click()
Text4.SelStart = 0
Text4.SelLength = Len(Text4.Text)
End Sub

Private Sub Text4_GotFocus()
Text4.SelStart = 0
Text4.SelLength = Len(Text4.Text)


End Sub

Private Sub Text5_Click()
Text5.SelStart = 0
Text5.SelLength = Len(Text5.Text)
End Sub

Private Sub Text5_GotFocus()
Text5.SelStart = 0
Text5.SelLength = Len(Text5.Text)
End Sub

Private Sub Text6_Click()
Text6.SelStart = 0
Text6.SelLength = Len(Text6.Text)
End Sub

Private Sub Text6_GotFocus()
Text6.SelStart = 0
Text6.SelLength = Len(Text6.Text)
End Sub