Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Şubat 2005 Perşembe

Sorted By Name Transfers Data



'UserForm1

'AddTools on UserForm1: Image1, Label1, ListBox1, ListBox2
Option Explicit

Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Sorted By Name Transfers Data"
Application.Visible = True
Call VeriDüzenle
Call ListeDüzenle
End Sub
Private Sub UserForm_Activate()
On Error Resume Next
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
On Error Resume Next
Application.Visible = True
End Sub
Sub VeriDüzenle()
On Error Resume Next
With ThisWorkbook.Sheets(1)
.Cells(1, 1) = "vsFlexArray1 [VSFLEX.vsFlexArrayCtrl.1][00] "
.Cells(2, 1) = "vsFlexString1 [VSFLEX.vsFlexStringCtrl.1][01] "
.Cells(3, 1) = "DHTMLEdit1 [DHTMLEdit.DHTMLEdit.1][02] "
.Cells(4, 1) = "DHTMLSafe1 [DHTMLSafe.DHTMLSafe.1][03] "
.Cells(5, 1) = "Knob1 [AUDIOCONTROL.KnobCtrl.1][04] "
.Cells(6, 1) = "LevelSlider1 [AUDIOCONTROL.LevelSliderCtrl.1][05] "
.Cells(7, 1) = "ListPad1 [ListPad.ListPad.1][06] "
.Cells(8, 1) = "Agent1 [Agent.Control.2][07] "
.Cells(9, 1) = "CheckBox1 [Forms.CheckBox.1][08] "
.Cells(10, 1) = "ComboBox1 [Forms.ComboBox.1][09] "
.Cells(11, 1) = "CommandButton1 [Forms.CommandButton.1][10] "
.Cells(12, 1) = "Frame1 [Forms.Frame.1][11] "
.Cells(13, 1) = "Image1 [Forms.Image.1][12] "
.Cells(14, 1) = "Label1 [Forms.Label.1][13] "
.Cells(15, 1) = "ListBox1 [Forms.ListBox.1][14] "
.Cells(16, 1) = "MultiPage2 [Forms.MultiPage.1][15] "
.Cells(17, 1) = "OptionButton1 [Forms.OptionButton.1][16] "
.Cells(18, 1) = "ScrollBar1 [Forms.ScrollBar.1][17] "
.Cells(19, 1) = "SpinButton1 [Forms.SpinButton.1][18] "
.Cells(20, 1) = "TabStrip1 [Forms.TabStrip.1][19] "
.Cells(21, 1) = "TextBox1 [Forms.TextBox.1][20] "
.Cells(22, 1) = "ToggleButton1 [Forms.ToggleButton.1][21] "
.Cells(23, 1) = "ImageCombo1 [MSComctlLib.ImageComboCtl.2][22] "
.Cells(24, 1) = "ImageList1 [MSComctlLib.ImageListCtrl.2][23] "
.Cells(25, 1) = "InkEdit1 [InkEd.InkEdit.1][24] "
.Cells(26, 1) = "InkPicture1 [msinkaut.InkPicture.1][25] "
.Cells(27, 1) = "ListView1 [MSComctlLib.ListViewCtrl.2][26] "
.Cells(28, 1) = "ChartSpace1 [OWC10.ChartSpace.10][27] "
.Cells(29, 1) = "ChartSpace2 [OWC11.ChartSpace.11][28] "
.Cells(30, 1) = "DataSourceControl1 [OWC10.DataSourceControl.10][29] "
.Cells(31, 1) = "DataSourceControl2 [OWC11.DataSourceControl.11][30] "
.Cells(32, 1) = "ViewCtl1 [OVCtl.OVCtl.1][31] "
.Cells(33, 1) = "PivotTable1 [OWC10.PivotTable.10][32] "
.Cells(34, 1) = "PivotTable2 [OWC11.PivotTable.11][33] "
.Cells(35, 1) = "RecordNavigationControl1 [OWC10.RecordNavigationControl.10][34] "
.Cells(36, 1) = "RecordNavigationControl2 [OWC11.RecordNavigationControl.11][35] "
.Cells(37, 1) = "Spreadsheet1 [OWC10.Spreadsheet.10][36] "
.Cells(38, 1) = "Spreadsheet2 [OWC11.Spreadsheet.11][37] "
.Cells(39, 1) = "ProgressBar1 [MSComctlLib.ProgCtrl.2][38] "
.Cells(40, 1) = "Slider1 [MSComctlLib.Slider.2][39] "
.Cells(41, 1) = "StatusBar1 [MSComctlLib.SBarCtrl.2][40] "
.Cells(42, 1) = "TabStrip2 [MSComctlLib.TabStrip.2][41] "
.Cells(43, 1) = "Toolbar1 [MSComctlLib.Toolbar.2][42] "
.Cells(44, 1) = "TreeView1 [MSComctlLib.TreeCtrl.2][43] "
.Cells(45, 1) = "WebBrowser1 [Shell.Explorer.2][44] "
.Cells(46, 1) = "MSVidCtl1 [MSVidCtl.MSVidCtl.1][45] "
.Cells(47, 1) = "Msie1 [MSIE.MsieCtrl.1][46] "
.Cells(48, 1) = "AMSREdit1 [Msrtedit.AAMSREdit.1][47] "
.Cells(49, 1) = "MSWebDVD1 [MSWebDVD.MSWebDVD.1][48] "
.Cells(50, 1) = "OleInstall1 [OlePrn.OleInstall.1][49] "
.Cells(51, 1) = "OWSPostData1 [OWS.PostData.1][50] "
.Cells(52, 1) = "Preview1 [Preview.Preview.1][51] "
.Cells(53, 1) = "ShockwaveFlash1 [ShockwaveFlash.ShockwaveFlash.10][52] "
.Cells(54, 1) = "SVGCtl1 [Adobe.SVGCtl.2][53] "
.Cells(55, 1) = "SysColorCtrl1 [SysColorCtrl.SysColorCtrl.1][54] "
.Cells(56, 1) = "MSInfo1 [Msinfo32.MSInfo.1][55] "
.Cells(57, 1) = "SystemMonitor1 [Sysmon.3][56] "
.Cells(58, 1) = "Calendar1 [MSCAL.Calendar.7][57] "
.Cells(59, 1) = "Control1 [TrialEnd.TrialEnd.1][58] "
.Cells(60, 1) = "WindowsMediaPlayer1 [WMPlayer.OCX.7][59] "
End With
End Sub
Sub ListeDüzenle()
On Error Resume Next
Set Ekran = Me
ListBox1.RowSource = "sayfa1!a1:a60"
ListBox2.RowSource = "sayfa1!a1:a60"
Call SıralıListele
End Sub

'Module1

Option Explicit
Public Ekran As MSForms.UserForm, EkranElemanı As Object
Option Base 1
Dim Adet As Integer, i As Integer, ii As Integer, iii As Integer, iv As Integer
Dim ListeHafıza()
Dim ListeRevizeHafıza()
Dim Veriler As Range
Dim SıralıVeriler As New Collection
Dim Takas1, Takas2 As Variant

Sub SıralıListele()
On Error Resume Next
For Each EkranElemanı In Ekran.Controls
i = 0
ii = 0
iii = 0
If EkranElemanı.name = "ListBox1" Then
'VBA.TypeName(EkranElemanı) = "ListBox"
Adet = EkranElemanı.ListCount
ReDim ListeHafıza(1 To Adet)
For Each Veriler In Range(EkranElemanı.RowSource)
i = i + 1
ListeHafıza(i) = Veriler
Next Veriler
For iv = 1 To UBound(ListeHafıza)
If Not WorksheetFunction.IsNumber(ListeHafıza(iv)) Then
ListeHafıza(iv) = VBA.Replace(ListeHafıza(iv), "i", "İ")
ListeHafıza(iv) = VBA.Replace(ListeHafıza(iv), "ı", "I")
ListeHafıza(iv) = VBA.Replace(ListeHafıza(iv), "ç", "Ç")
ListeHafıza(iv) = VBA.Replace(ListeHafıza(iv), "ğ", "Ğ")
ListeHafıza(iv) = VBA.Replace(ListeHafıza(iv), "ş", "Ş")
ListeHafıza(iv) = VBA.Replace(ListeHafıza(iv), "ü", "Ü")
ListeHafıza(iv) = VBA.Replace(ListeHafıza(iv), "ö", "Ö")
ListeHafıza(iv) = VBA.UCase(ListeHafıza(iv))
End If
Next iv
For i = 1 To UBound(ListeHafıza)
For ii = i + 1 To UBound(ListeHafıza) - 1
If ListeHafıza(i) = ListeHafıza(ii) Then
ListeHafıza(i) = ""
End If
Next ii
Next i
EkranElemanı.RowSource = ""
For i = 1 To UBound(ListeHafıza)
If ListeHafıza(i) <> "" Then
iii = iii + 1
ReDim Preserve ListeRevizeHafıza(iii)
ListeRevizeHafıza(iii) = ListeHafıza(i)
End If
Next i
i = 0
ii = 0
Adet = UBound(ListeRevizeHafıza)
If VBA.Err = 9 Then GoTo Hata
For i = 1 To UBound(ListeRevizeHafıza)
SıralıVeriler.Add ListeRevizeHafıza(i)
Next i
For i = 1 To SıralıVeriler.Count - 1
For ii = i + 1 To SıralıVeriler.Count
If SıralıVeriler(i) > SıralıVeriler(ii) Then
Takas1 = SıralıVeriler(i)
Takas2 = SıralıVeriler(ii)
SıralıVeriler.Add Takas1, before:=ii
SıralıVeriler.Add Takas2, before:=i
SıralıVeriler.Remove i + 1
SıralıVeriler.Remove ii + 1
End If
Next ii
Next i
For i = 1 To SıralıVeriler.Count
EkranElemanı.AddItem SıralıVeriler(i)
Next i
For i = SıralıVeriler.Count To 1 Step -1
SıralıVeriler.Remove i
Next i
End If
Erase ListeHafıza
Erase ListeRevizeHafıza
Next EkranElemanı
Exit Sub
Hata:
Erase ListeHafıza
Erase ListeRevizeHafıza
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