Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Şubat 2005 Pazar

Reset Model



'Module1
Option Explicit
Dim Sayfa As Worksheet
Dim Alan As Range

Sub FormülleriKoruyarakTabloTemizlemek() 'ResetModel
On Error Resume Next
Set Sayfa = ThisWorkbook.Sheets("Sayfa1")
Set Alan = Sayfa.UsedRange
Alan.SpecialCells(xlCellTypeConstants, 1).ClearContents 'Value Clean

Alan.SpecialCells(xlCellTypeConstants, 2).ClearContents 'Text Clean
End Sub

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

1 Şubat 2005 Salı

Creating Regions

'Module1
Option Explicit
Dim Hücre As Range
Dim i As Single

Sub BölgeOluşturma() 'Creating regions
On Error Resume Next
Cells.Delete Shift:=xlUp
i = 0
For Each Hücre In Range("C3:C17,D4:D6,E7:E9,F10:F12,G7:G9,H4:H6,I3:I5,J3:K17,M3:M14,N15:N16,O17:P17,Q15:R16,R3:S14")
With Hücre
If Not .Rows.Hidden Then
i = i + 1
.Value = i
.Font.Bold = True
.Font.Size = 8
.Columns.AutoFit
Else
.Clear
End If
End With
Next Hücre
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