Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Ağustos 2006 Pazar

FileSystem Property



'Module1
Option Explicit
Dim fs, d, s

Sub ShowFileSystemType()
'Available return types include FAT, NTFS, and CDFS.
Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive("c:") 'a,b,c,d,e,f,g...
s = d.FileSystem
MsgBox "Dosyalama Sisteminiz: " & s & Chr(13) & Chr(13) & "Mustafa ULUSARAÇ" & Chr(13) & "01ulusarac@superonline.com", vbInformation, "[PBİD®] Available return types inculude FAT, NTFS and CDFS"
End Sub

10 Ağustos 2006 Perşembe

ComboBox Cntrl 2




'UserForm1

Option Explicit
Dim No

Private Sub ComboBox1_Change()
On Error Resume Next
Sheets("Sayfa1").Cells(ComboBox1.ListIndex + 1, 1).Select
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
On Error Resume Next
No = ActiveWindow.ScrollRow
If KeyCode = 13 Then Cells(No, 1).Activate
End Sub
Private Sub UserForm_Initialize()
On Error Resume Next
Sheets("Sayfa1").Rows("1:20").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom ComboBox1.RowSource = "Sayfa1!A1:A20"
ComboBox1.ListIndex = -1
End Sub

1 Ağustos 2006 Salı

ComboBox Cntrl 1



'UserForm1

Private Sub UserForm_Initialize()
On Error Resume Next
MyForm = Me.Name
ComboBox1.RowSource = "Sayfa1!A1:A20"
Call OrganizeComboBox
End Sub

 'Module1

Dim MyForm As Variant
Option Base 1

Sub OrganizeComboBox()
On Error Resume Next
Dim noData, i, j, k, m As Integer
Dim MyComboArray()
Dim MyRevizedComboArray()
Dim MyData As Range
Dim SortedColl As New Collection
Dim Swap1, Swap2 As Variant
For Each MyControl In UserForms(MyForm).Controls
i = 0
j = 0
k = 0
If TypeName(MyControl) = "ComboBox" Then
noData = MyControl.ListCount
ReDim MyComboArray(noData)
For Each MyData In Range(MyControl.RowSource)
i = i + 1
MyComboArray(i) = MyData
Next MyData
For m = 1 To UBound(MyComboArray)
If Not WorksheetFunction.IsNumber(MyComboArray(m)) Then
MyComboArray(m) = UCase(MyComboArray(m))
MyComboArray(m) = Replace(MyComboArray(m), "Ç", "Ç")
MyComboArray(m) = Replace(MyComboArray(m), "İ", "İ")
MyComboArray(m) = Replace(MyComboArray(m), "Ğ", "Ğ")
MyComboArray(m) = Replace(MyComboArray(m), "Ş", "Ş")
MyComboArray(m) = Replace(MyComboArray(m), "Ü", "Ü")
MyComboArray(m) = Replace(MyComboArray(m), "Ö", "Ö")
End If
Next m
For i = 1 To UBound(MyComboArray)
For j = i + 1 To UBound(MyComboArray) - 1
If MyComboArray(i) = MyComboArray(j) Then
MyComboArray(i) = ""
End If
Next j
Next i
MyControl.RowSource = ""
For i = 1 To UBound(MyComboArray)
If MyComboArray(i) <> "" Then
k = k + 1
ReDim Preserve MyRevizedComboArray(k)
MyRevizedComboArray(k) = MyComboArray(i)
End If
Next i
i = 0
j = 0
For i = 1 To UBound(MyRevizedComboArray)
SortedColl.Add MyRevizedComboArray(i)
Next i
'On Error Resume Next
'For i = 1 To UBound(MyRevizedComboArray)
'MyRevizedComboArray(i) = WorksheetFunction.Small(MyRevizedComboArray, i)
'Next

For i = 1 To SortedColl.Count - 1
For j = i + 1 To SortedColl.Count
If SortedColl(i) > SortedColl(j) Then
Swap1 = SortedColl(i)
Swap2 = SortedColl(j)
SortedColl.Add Swap1, before:=j
SortedColl.Add Swap2, before:=i
SortedColl.Remove i + 1
SortedColl.Remove j + 1
End If
Next j
Next i
For i = 1 To SortedColl.Count
MyControl.AddItem SortedColl(i)
Next i
For i = SortedColl.Count To 1 Step -1
SortedColl.Remove i
Next i
End If
Erase MyComboArray
Erase MyRevizedComboArray
Next MyControl
End Sub

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