home *** CD-ROM | disk | FTP | other *** search
/ Tools / WinSN5.0Ver.iso / PVb5.0 / VB / SAMPLES / PGUIDE / GEOFACTS / GEOFACTS.BAS next >
Encoding:
BASIC Source File  |  1997-02-02  |  3.6 KB  |  122 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3. ' ╙╔╙┌╩²╛▌╬─╝■╬¬ Excel ╬─╝■ú¼╦∙╥╘╖╓▒≡╢¿╥σ╣ñ╫≈▓╛║═╣ñ╫≈▒φ
  4. Public wbWorld As Object
  5. Public shtWorld As Object
  6.  
  7. Sub Setup()
  8.     ChDir App.Path
  9.     ChDrive App.Path
  10.     ' ╗±╚í WORLD.XLS ╓╨╡─╡┌╥╗╕÷╣ñ╫≈▒φ
  11.     Set shtWorld = GetObject("world.xls")
  12.     ' ╗±╚í╣ñ╫≈▓╛
  13.     Set wbWorld = shtWorld.Application.Workbooks("world.xls")
  14. End Sub
  15.  
  16. ' ╜½╢╘╧≤╔Φ╓├╬¬ Nothingíú
  17. Sub CleanUp()
  18. ' ╥¬╩╟├╗╙╨╞Σ╦√╙ª╙├│╠╨≥╗≥╙├╗º╜½ Microsoft Excel ╝╙╘╪ú¼
  19. ' ╒Γ╜½╟┐╓╞╜½╞Σ╨╢╘╪íú
  20.     Set shtWorld = Nothing
  21.     Set wbWorld = Nothing
  22. End Sub
  23.  
  24. ' ╙├╣ñ╫≈▓╛╓╨╡─╣ñ╫≈▒φ├√╠ε│Σ Continents ╫Θ║╧┐≥
  25. Sub FillContinentsList()
  26.     Dim shtContinent As Excel.Worksheet
  27.     
  28.     ' ▒Θ└·╣ñ╫≈▒φ╝»║╧ú¼▓ó╜½├┐╒┼╣ñ╫≈▒φ╡─├√│╞╠φ╝╙╡╜╫Θ║╧┐≥╓╨
  29.     For Each shtContinent In wbWorld.Sheets
  30.         frmGeoFacts.cmbContinents.AddItem shtContinent.Name
  31.     Next
  32.     ' ╤í╢¿╡┌╥╗╧ε▓ó╧╘╩╛╘┌╫Θ║╧┐≥╓╨
  33.     frmGeoFacts.cmbContinents.Text = frmGeoFacts.cmbContinents.List(0)
  34.  
  35.     Set shtContinent = Nothing
  36. End Sub
  37.  
  38. ' ╙├╕°╢¿╡─╙δ┤≤┬╜╧α╣╪╡─╠╪╒≈╡─├√│╞╠ε│Σ╡╜ Continents ╫Θ║╧┐≥╓╨
  39. Sub FillFeaturesList()
  40.     Dim shtContinent As Excel.Worksheet
  41.     Dim rngFeatureList As Excel.Range
  42.     Dim intFirstBlankCell As Integer
  43.     Dim loop1 As Integer
  44.  
  45.     ' ╥■║¼╛╔╡─ lstTopRanking ┴╨▒φ┐≥.
  46.     frmGeoFacts.lstTopRanking.Visible = False
  47.     
  48.     ' ╗±╚í╘┌ Continents ╫Θ║╧┐≥╓╨╤í╢¿╡─┤≤┬╜├√│╞╡─╣ñ╫≈▒φ
  49.     Set shtContinent = wbWorld.Sheets(frmGeoFacts.cmbContinents.Text)
  50.     ' ╜½╒Γ╕÷╣ñ╫≈▒φ╡─╡┌╥╗╨╨╕│╓╡╕°╥╗╕÷╢╘╧≤
  51.     Set rngFeatureList = shtContinent.Rows(1)
  52.     
  53.     ' ┼╨╢╧╩╟╖±╬¬┐╒┴╨▒φ
  54.     If (rngFeatureList.Cells(1, 1) = "") Then
  55.         intFirstBlankCell = 0
  56.     Else
  57.         ' ▓Θ╒╥╡┌╥╗╕÷┐╒╡Ñ╘¬╡─╦∙╘┌╨╨
  58.         intFirstBlankCell = rngFeatureList.Find("").Column
  59.     End If
  60.     
  61.     ' ╟σ┐╒ features ╫Θ║╧┐≥╓╨╟░├µ╡──┌╚▌
  62.     frmGeoFacts.cmbFeatures.Clear
  63.             
  64.     ' ╠φ╝╙╧ε╡╜ features ╫Θ║╧┐≥
  65.     For loop1 = 1 To intFirstBlankCell
  66.             frmGeoFacts.cmbFeatures.AddItem rngFeatureList.Cells(1, loop1)
  67.     Next
  68.     
  69.     ' ╤í╢¿╡┌╥╗╧ε▓ó╧╘╩╛╘┌╫Θ║╧┐≥╓╨
  70.     frmGeoFacts.cmbFeatures.Text = frmGeoFacts.cmbFeatures.List(0)
  71.  
  72.     ' ╟σ│²
  73.     Set shtContinent = Nothing
  74.     Set rngFeatureList = Nothing
  75. End Sub
  76.  
  77. ' ╠ε│Σ lstTopRanking ┴╨▒φ┐≥
  78. Sub FillTopRankingList()
  79.     Dim shtContinent As Excel.Worksheet
  80.     Dim intColumOfFeature As Integer
  81.     Dim rngRankedList As Excel.Range
  82.     Dim intFirstBlankCell As Integer
  83.     Dim loop1 As Integer
  84.     
  85.     ' ╗±╚í╘┌ Continents ╫Θ║╧┐≥╓╨╤í╢¿╡─┤≤┬╜├√│╞╡─╣ñ╫≈▒φ
  86.     Set shtContinent = wbWorld.Sheets(frmGeoFacts.cmbContinents.Text)
  87.     
  88.     ' ╟σ┐╒ ranking ┴╨▒φ┐≥╓╨╟░├µ╡──┌╚▌
  89.     frmGeoFacts.lstTopRanking.Clear
  90.     
  91.     ' ╚τ╣√ feature ╫Θ║╧┐≥╓╨╤í╢¿╬¬┐╒ú¼▓╗╫÷╚╬║╬▓┘╫≈
  92.     If (frmGeoFacts.cmbFeatures <> "") Then
  93.         
  94.         ' ▓Θ┐┤╘┌╡τ╫╙╩²╛▌▒φ╓╨╡┌╥╗╨╨╓╨╙╔ feature ╤í╢¿╡─┴╨
  95.         intColumOfFeature = shtContinent.Rows(1).Find(frmGeoFacts.cmbFeatures.Text).Column
  96.         
  97.         ' ╜½╕├┴╨╕│╓╡╕°╥╗╕÷╢╘╧≤
  98.          Set rngRankedList = shtContinent.Columns(intColumOfFeature)
  99.         
  100.         ' ┼╨╢╧╩╟╖±╬¬┐╒┴╨▒φ
  101.         If (rngRankedList.Cells(1, 1) = "") Then
  102.             intFirstBlankCell = 0
  103.         Else
  104.             ' ▓Θ╒╥╡┌╥╗╕÷┐╒╡Ñ╘¬╡─╦∙╘┌╨╨
  105.             intFirstBlankCell = rngRankedList.Find("").Row
  106.         End If
  107.                 
  108.         ' ╠φ╝╙╧ε╡╜ TopRanking ┴╨▒φ┐≥
  109.         For loop1 = 2 To intFirstBlankCell
  110.             frmGeoFacts.lstTopRanking.AddItem rngRankedList.Cells(loop1, 1)
  111.         Next
  112.     
  113.         ' ╧╘╩╛╨┬╡─ ranking ┴╨▒φ
  114.         frmGeoFacts.lstTopRanking.Visible = True
  115.     
  116.     End If
  117.     
  118.     ' ╟σ│²
  119.     Set shtContinent = Nothing
  120.     Set rngRankedList = Nothing
  121. End Sub
  122.