home *** CD-ROM | disk | FTP | other *** search
/ Master 95 #1 / MASTER95_1.iso / microsof / vbasic4 / vb4-6.cab / geofacts.bas < prev    next >
Encoding:
BASIC Source File  |  1995-07-26  |  3.9 KB  |  123 lines
  1. Attribute VB_Name = "Module1"
  2. Public wbWorld As Object
  3. Public shtWorld As Object
  4.  
  5. Sub Setup()
  6.     ChDir App.Path
  7.     ChDrive App.Path
  8.     ' Get the first sheet in WORLD.XLS.
  9.     Set shtWorld = GetObject("world.xls")
  10.     ' Get the workbook.
  11.     Set wbWorld = shtWorld.Application.Workbooks("world.xls")
  12. End Sub
  13.  
  14. ' Set the objects to Nothing.
  15. Sub CleanUp()
  16.     ' This should force an unload of Microsoft Excel,
  17.     ' providing no other applications or users have it loaded.
  18.     Set shtWorld = Nothing
  19.     Set wbWorld = Nothing
  20. End Sub
  21.  
  22. ' Fill the Continents combo box with the names
  23. ' of the sheets in the workbook.
  24. Sub FillContinentsList()
  25.     Dim shtContinent As Object
  26.     
  27.     ' Iterate through the collection of sheets and add
  28.     ' the name of each sheet to the combo box.
  29.     For Each shtContinent In wbWorld.Sheets
  30.         Form1.listContinents.AddItem shtContinent.Name
  31.     Next
  32.     ' Select the first item and display it in the combo box.
  33.     Form1.listContinents.Text = Form1.listContinents.List(0)
  34.  
  35.     Set shtContinent = Nothing
  36. End Sub
  37.  
  38. ' Fill the Continents combo box with the names
  39. ' of the features corresponding to a given continent.
  40. Sub FillFeaturesList()
  41.     Dim shtContinent As Object
  42.     Dim rngFeatureList As Object
  43.     Dim intFirstBlankCell As Integer
  44.     Dim loop1 As Integer
  45.  
  46.     ' Hide the old ranking list.
  47.     Form1.listTopRanking.Visible = False
  48.     
  49.     ' Get the sheet with the name of the continent selected in the Continents combo box.
  50.     Set shtContinent = wbWorld.Sheets(Form1.listContinents.Text)
  51.     ' Assign the first row of this sheet to an object.
  52.     Set rngFeatureList = shtContinent.rows(1)
  53.     
  54.     ' See if it's an empty list.
  55.     If (rngFeatureList.Cells(1, 1) = "") Then
  56.         intFirstBlankCell = 0
  57.     Else
  58.         ' Search the row for the first blank cell.
  59.         intFirstBlankCell = rngFeatureList.find("").column
  60.     End If
  61.     
  62.     ' Empty the previous contents of the features combo box.
  63.     Form1.listFeatures.Clear
  64.             
  65.     ' Add the items to the features combo box.
  66.     For loop1 = 1 To intFirstBlankCell
  67.             Form1.listFeatures.AddItem rngFeatureList.Cells(1, loop1)
  68.     Next
  69.     
  70.     ' Select the first item and display it in the combo box.
  71.     Form1.listFeatures.Text = Form1.listFeatures.List(0)
  72.  
  73.     ' Clean up.
  74.     Set shtContinent = Nothing
  75.     Set rngFeatureList = Nothing
  76. End Sub
  77.  
  78. ' Fill the list of ranking items.
  79. Sub FillTopRankingList()
  80.     Dim shtContinent As Object
  81.     Dim intColumOfFeature As Integer
  82.     Dim rngRankedList As Object
  83.     Dim intFirstBlankCell As Integer
  84.     Dim loop1 As Integer
  85.     
  86.     ' Get the sheet with the name of the continent selected in the Continents combo box.
  87.     Set shtContinent = wbWorld.Sheets(Form1.listContinents.Text)
  88.     
  89.     ' Empty the previous contents of the ranking list box.
  90.     Form1.listTopRanking.Clear
  91.     
  92.     ' If the feature selection is blank, do nothing.
  93.     If (Form1.listFeatures <> "") Then
  94.         
  95.         ' Look up the column of the selected feature in the first row of the spreadsheet.
  96.         intColumOfFeature = shtContinent.rows(1).find(Form1.listFeatures.Text).column
  97.         
  98.         ' Assign the column to an object.
  99.          Set rngRankedList = shtContinent.Columns(intColumOfFeature)
  100.         
  101.         ' See if it's a blank list.
  102.         If (rngRankedList.Cells(1, 1) = "") Then
  103.             intFirstBlankCell = 0
  104.         Else
  105.             ' Search the row for the first blank cell.
  106.             intFirstBlankCell = rngRankedList.find("").row
  107.         End If
  108.                 
  109.         ' Add the items to the features combo box.
  110.         For loop1 = 2 To intFirstBlankCell
  111.             Form1.listTopRanking.AddItem rngRankedList.Cells(loop1, 1)
  112.         Next
  113.     
  114.         ' Show the new ranking list.
  115.         Form1.listTopRanking.Visible = True
  116.     
  117.     End If
  118.     
  119.     ' Clean up.
  120.     Set shtContinent = Nothing
  121.     Set rngRankedList = Nothing
  122. End Sub
  123.