Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

1 Ocak 2007 Pazartesi

Get original and classified data to sort...



'UserForm1

'A) Windows XP® Office 2003® Normal Referance List

'Visual Basic For Aplication
'Microsoft Forms 2.0 Object Library
'Microsoft Excel 11.0 Object Library
'OLE Automation
'Microsoft Office 11.0 Object Library
'B) UserForm1'e Eklenen Araçlar (Add Tools)
'Frame1
'Frame1\Image1, Label1, Label2
'ListBox1, ListBox2 , Label3, Label4
'CommandButton1, CommandButton2, CommandButtom3

Option Explicit
Dim Sayfa As Worksheet
Dim Alan As Range, Hücre As Range
Dim Filitre As New Collection
Dim i As Integer, j As Integer
Dim Takas1, Takas2, Item
Private Sub UserForm_Initialize()

On Error Resume Next
Me.Caption = "[PBİD®] Get original and classified data to sort..."
Call EkranDüzenle
Call BellekBilgisi
End Sub
Private Sub CommandButton1_Click()
'Get Filter Data

On Error Resume Next
ListBox1.Clear
ListBox2.Clear
Set Filitre = Nothing
Set Alan = Range("A1:A94")
For Each Hücre In Alan
ListBox1.AddItem VBA.CStr(Hücre.Value)
Filitre.Add Hücre.Value, VBA.CStr(Hücre.Value)
Next Hücre
Label3.Caption = "Toplam Kayıt Sayısı [Total Records]: " & Alan.Count
Label4.Caption = "Nehir Sayısı [River Counts]: " & Filitre.Count
For Each Item In Filitre
ListBox2.AddItem Item
Next Item
End Sub
Private Sub CommandButton2_Click()
'A-Z Sort

On Error GoTo 0
ListBox2.Clear
For i = 1 To (Filitre.Count - 1)
For j = (i + 1) To Filitre.Count
If (Filitre(i) > Filitre(j)) Then'Büyük Olanı Sorgula
Takas1 = Filitre(i)
Takas2 = Filitre(j)
Filitre.Add Takas1, After:=j
Filitre.Add Takas2, After:=i
Filitre.Remove i
Filitre.Remove j
End If
Next j
Next i
For Each Item In Filitre
ListBox2.AddItem Item
Next Item
End Sub
Private Sub CommandButton3_Click()
'Z-A Sort

On Error GoTo 0
ListBox2.Clear
For i = 1 To Filitre.Count - 1
For j = (i + 1) To Filitre.Count
If (Filitre(i) => Filitre(j)) Then'Küçük Olanı Sorgula
Else
Takas1 = Filitre(i)
Takas2 = Filitre(j)
Filitre.Add Takas1, After:=j
Filitre.Add Takas2, After:=i
Filitre.Remove i
Filitre.Remove j
End If
Next j
Next i
For Each Item In Filitre
ListBox2.AddItem Item
Next Item
End Sub
Private Sub EkranDüzenle()

On Error Resume Next
With Me
           .Height = 264
           .Width = 453
           .BackColor = &H8000000F
End With
With Frame1
.Caption = ""
.Top = -2
.Left = -2
.Height = 36
.Width = Me.Width + 12
If .Picture Is Nothing Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\zarifVİSTA.bmp")
.PictureAlignment = fmPictureAlignmentTopLeft
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
With Image1
.BackStyle = fmBackStyleTransparent
.BorderColor = &HFF0000
.BorderStyle = fmBorderStyleSingle
.Top = 6
.Left = 6
.Height = 24
.Width = 24
If .Picture Is Nothing Then .Picture = LoadPicture("C:\Documents and Settings\PC\Desktop\BLOGSPOT\Örnekİkonlar\PBİD.ico")
End With
With Label1
.Caption = " " & "Mustafa ULUSARAÇ"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 6
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
With Label2
.Caption = " " & "01ulusarac@superonline.com"
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.Left = 30
.Top = 18
.Height = 12
.Width = 198
.Font.Bold = True
.ForeColor = &HFF0000
End With
End With
With Label3
.Caption = ""
.Left = 6
.Top = 36
.Height = 18
.Width = 218
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignCenter
.Font.Bold = True
End With
With Label4
.Caption = ""
.Left = 224
.Top = 36
.Height = 18
.Width = 218
.SpecialEffect = fmSpecialEffectEtched
.TextAlign = fmTextAlignCenter
.Font.Bold = True
End With
With ListBox1
.Left = 6
.Top = 54
.Height = 159.8
.Width = 218
.BackColor = &H80000013
.SpecialEffect = fmSpecialEffectEtched
End With
With ListBox2
.Left = 224
.Top = 54
.Height = 159.8
.Width = 218
.BackColor = &H80000018
.SpecialEffect = fmSpecialEffectEtched
End With
With CommandButton1
.Left = 6
.Top = 216
.Height = 18
.Width = 218
.Caption = "Bilgi Getir [Get Data]"
.Font.Bold = True
End With
With CommandButton2
.Left = 228
.Top = 216
.Height = 18
.Width = 102
.Caption = "A-Z Sırala [Sort]"
.Font.Bold = True
End With
With CommandButton3
.Left = 336
.Top = 216
.Height = 18
.Width = 102
.Caption = "Z-A Sırala [Sort]"
.Font.Bold = True
End With
End Sub
Private Sub BellekBilgisi()

On Error Resume Next
ReDim Bellek(1 To 94, 1 To 1)
Bellek(1, 1) = "Colorado (Argentina) - 402.956 km² "
Bellek(2, 1) = "Amazon - 6.144.727 km² "
Bellek(3, 1) = "Pearl - 409.458 km² "
Bellek(4, 1) = "Kongo - 3.730.474 km² "
Bellek(5, 1) = "Irrawaddy - 413.674 km² "
Bellek(6, 1) = "Nil - 3.254.555 km²"
Bellek(7, 1) = "Senegal - 419.659 km² "
Bellek(8, 1) = "Mississippi - 3.202.230 km² "
Bellek(9, 1) = "Limpopo - 421.168 km² "
Bellek(10, 1) = "Obi - 2.972.497 km² "
Bellek(11, 1) = "Don - 458.703 km² "
Bellek(12, 1) = "Parana - 2.582.672 km² "
Bellek(13, 1) = "Juba - 497.655 km² "
Bellek(14, 1) = "Yenisey - 2.554.482 km² "
Bellek(15, 1) = "Balkaş - 512.010 km² "
Bellek(16, 1) = "Çad - 2.497.918 km² "
Bellek(17, 1) = "Dinyeper - 531.817 km² "
Bellek(18, 1) = "Lena - 2.306.772 km² "
Bellek(19, 1) = "Amu Darya - 534.764 km² "
Bellek(20, 1) = "NijSinter - 2.261.763 km² "
Bellek(21, 1) = "Rio Grande - 608.023 km² "
Bellek(22, 1) = "Amur - 1.929.981 km² "
Bellek(23, 1) = "São Francisco - 617.812 km² "
Bellek(24, 1) = "Mackenzie - 1.743.058 km² "
Bellek(25, 1) = "Brahmaputra - 651.334 km² "
Bellek(26, 1) = "Yang-Çe (Chang Jiang) - 1.722.155 km² "
Bellek(27, 1) = "Columbia - 657.490 km² "
Bellek(28, 1) = "Volga - 1.410.994 km² "
Bellek(29, 1) = "Kolyma - 679.908 km² "
Bellek(30, 1) = "Zambezi - 1.332.574 km² "
Bellek(31, 1) = "Colorado (ABD) - 703.132 km² "
Bellek(32, 1) = "Tarim - 1.152.447 km² "
Bellek(33, 1) = "Okavango - 721.277 km² "
Bellek(34, 1) = "Nelson - 1.093.442 km² "
Bellek(35, 1) = "Tocantins - 764.183 km² "
Bellek(36, 1) = "Sint - 1.081.733 km² "
Bellek(37, 1) = "Dicle-Fırat - 765.831 km² "
Bellek(38, 1) = "St. Lawrence - 1.049.621 km² "
Bellek(39, 1) = "Syr Darya - 782.669 km² "
Bellek(40, 1) = "Murray - 1.072.000 km² "
Bellek(41, 1) = "Tuna - 795.686 km² "
Bellek(42, 1) = "Ganj - 1.016.104 km² "
Bellek(43, 1) = "Mekong - 805.627 km² "
Bellek(44, 1) = "Orinoko - 953.598 km² "
Bellek(45, 1) = "Yukon - 847.642 km² "
Bellek(46, 1) = "Huang He - 945.065 km² "
Bellek(47, 1) = "Orange - 941.421 km² "
Bellek(48, 1) = "Orange - 941.421 km² "
Bellek(49, 1) = "Huang He - 945.065 km² "
Bellek(50, 1) = "Yukon - 847.642 km² "
Bellek(51, 1) = "Orinoko - 953.598 km² "
Bellek(52, 1) = "Mekong - 805.627 km² "
Bellek(53, 1) = "Ganj - 1.016.104 km² "
Bellek(54, 1) = "Tuna - 795.686 km² "
Bellek(55, 1) = "Murray - 1.072.000 km² "
Bellek(56, 1) = "Syr Darya - 782.669 km² "
Bellek(57, 1) = "St. Lawrence - 1.049.621 km² "
Bellek(58, 1) = "Dicle-Fırat - 765.831 km² "
Bellek(59, 1) = "Sint - 1.081.733 km² "
Bellek(60, 1) = "Tocantins - 764.183 km² "
Bellek(61, 1) = "Nelson - 1.093.442 km² "
Bellek(62, 1) = "Okavango - 721.277 km² "
Bellek(63, 1) = "Tarim - 1.152.447 km² "
Bellek(64, 1) = "Colorado (ABD) - 703.132 km² "
Bellek(65, 1) = "Zambezi - 1.332.574 km² "
Bellek(66, 1) = "Kolyma - 679.908 km² "
Bellek(67, 1) = "Volga - 1.410.994 km² "
Bellek(68, 1) = "Columbia - 657.490 km² "
Bellek(69, 1) = "Yang-Çe (Chang Jiang) - 1.722.155 km² "
Bellek(70, 1) = "Brahmaputra - 651.334 km² "
Bellek(71, 1) = "Mackenzie - 1.743.058 km² "
Bellek(72, 1) = "São Francisco - 617.812 km² "
Bellek(73, 1) = "Amur - 1.929.981 km² "
Bellek(74, 1) = "Rio Grande - 608.023 km² "
Bellek(75, 1) = "NijSinter - 2.261.763 km² "
Bellek(76, 1) = "Amu Darya - 534.764 km² "
Bellek(77, 1) = "Lena - 2.306.772 km² "
Bellek(78, 1) = "Dinyeper - 531.817 km² "
Bellek(79, 1) = "Çad - 2.497.918 km² "
Bellek(80, 1) = "Balkaş - 512.010 km² "
Bellek(81, 1) = "Yenisey - 2.554.482 km² "
Bellek(82, 1) = "Juba - 497.655 km² "
Bellek(83, 1) = "Parana - 2.582.672 km² "
Bellek(84, 1) = "Don - 458.703 km² "
Bellek(85, 1) = "Obi - 2.972.497 km² "
Bellek(86, 1) = "Limpopo - 421.168 km² "
Bellek(87, 1) = "Mississippi - 3.202.230 km² "
Bellek(88, 1) = "Senegal - 419.659 km² "
Bellek(89, 1) = "Nil - 3.254.555 km²"
Bellek(90, 1) = "Irrawaddy - 413.674 km² "
Bellek(91, 1) = "Kongo - 3.730.474 km² "
Bellek(92, 1) = "Pearl - 409.458 km² "
Bellek(93, 1) = "Amazon - 6.144.727 km² "
Bellek(94, 1) = "Colorado (Argentina) - 402.956 km² "
For Each Sayfa In ThisWorkbook.Sheets
If Sayfa.Name = "Rivers" Then GoTo Devam
Next Sayfa
Sheets.Add Sheets(1)
ActiveSheet.Name = "Rivers"
Devam:
Sheets("Rivers").Select
Cells.Select: Selection.Delete Shift:=xlUp
Range("A1:A94").Value = Bellek
[A1].Select
End Sub 

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul