Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

10 Nisan 2012 Salı

Find Method At UsedRange [2]




'UserForm1

'A. Available References List
'1) Name: VBA, Description: Visual Basic For Applications, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
'2) Name: Excel, Description: Microsoft Excel 11.0 Object Library, FullPath: C:\Program Files (x86)\Microsoft Office\OFFICE11\EXCEL.EXE
'3) Name: stdole, Description: OLE Automation, FullPath: C:\Windows\SysWOW64\stdole2.tlb
'4) Name: Office, Description: Microsoft Office 11.0 Object Library, FullPath: C:\Program Files (x86)\Common Files\Microsoft Shared\OFFICE11\MSO.DLL
'5) Name: MSForms, Description: Microsoft Forms 2.0 Object Library, FullPath: C:\Windows\SysWOW64\FM20.DLL
'B. Available Tools List
'1) İmage1, Label1, Label2
'2) Label3, TextBox1
'3) Label4, Label5
'4) Label6, ComboBox1
'5) CommandButton1, CommandButton2, CommandButton3
'C. Find Method
'1) What:=hStr
'2) After:=Range(hAdr)
'3) LookAt:=xlPart/xlWhole
'4) LookIn:=xlFormulas/xlValue
'5) SearchOrder:=xlByRows/xlByColumns
'6) SearchDirection:=xlPrevious/xlNext
Option Explicit
Private hStr As Variant
Private hRng As Range
Private hAdd As String
Private hLat As Double
Private Bellek(1 To 47, 1 To 1)
Private Sub UserForm_Initialize()
On Error Resume Next
Me.Caption = "[PBİD®] Find Method At UsedRange [2]"
Call Bellek_Kur
Call Ekran_Kur
End Sub
Private Sub ComboBox1_Change()
On Error Resume Next
hLat = ComboBox1.ListIndex + 1
TextBox1.Value = ""
Label5.Caption = ""
End Sub
Private Sub CommandButton1_Click()
On Error GoTo Hata
hStr = TextBox1.Value
Label5.Caption = ""
Set hRng = ActiveSheet.UsedRange.Find(What:=hStr, After:=Range("$A$1"), LookIn:=xlFormulas, LookAt:=hLat, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, SearchFormat:=False)
hAdd = hRng.Address
Label5.Caption = hAdd & " - " & hRng.Value
Exit Sub
Hata:
Label5.Caption = ""
End Sub
Private Sub CommandButton2_Click()
On Error GoTo Hata
Label5.Caption = ""
Cells.FindNext
Set hRng = ActiveSheet.UsedRange.FindNext(After:=Range(hAdd))
hAdd = hRng.Address
Label5.Caption = hAdd & " - " & hRng.Value
Exit Sub
Hata:
Label5.Caption = ""
End Sub
Private Sub CommandButton3_Click()
On Error GoTo Hata
Label5.Caption = ""
Set hRng = ActiveSheet.UsedRange.FindPrevious(After:=Range(hAdd))
hAdd = hRng.Address
If hRng.Row = 1 Then Exit Sub
Label5.Caption = hAdd & " - " & hRng.Value
Exit Sub
Hata:
Label5.Caption = ""
End Sub
Private Sub Ekran_Kur()
On Error Resume Next
With Me
.BackColor = vbWhite
.Height = 124
.Width = 318
.Picture = Resim(URL1)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = True
.SpecialEffect = fmSpecialEffectFlat
With Image1
.Top = 6
.Left = 6
.Height = 24
.Width = 24
.BackStyle = fmBackStyleTransparent
.BorderStyle = fmBorderStyleSingle
.BorderColor = vbBlue
.Picture = Resim(URL2)
.PictureAlignment = fmPictureAlignmentCenter
.PictureSizeMode = fmPictureSizeModeClip
.PictureTiling = False
End With
With Label1
.Left = 36
.Top = 6
.Height = 12
.Width = 420
.Caption = "Mustafa ULUSARAÇ"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label2
.Left = 36
.Top = 18
.Height = 12
.Width = 420
.Caption = "01ulusarac@superonline.com"
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
.BackStyle = fmBackStyleTransparent
.Font.Bold = True
.Font.Name = "Arial"
.ForeColor = vbBlue
End With
With Label3
.Left = 6
.Top = 36
.Height = 18
.Width = 66
.Caption = " What"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With TextBox1
.Left = 54
.Top = 36
.Height = 18
.Width = 252
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = vbBlue
.BackColor = &H80000018
End With
With Label4
.Left = 6
.Top = 54
.Height = 18
.Width = 48
.Caption = " Finded"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label5
.Left = 54
.Top = 54
.Height = 18
.Width = 252
.Caption = ""
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With Label6
.Left = 6
.Top = 78
.Height = 18
.Width = 48
.Caption = " LookAt"
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
.TextAlign = fmTextAlignLeft
End With
With ComboBox1
.Left = 54
.Top = 78
.Height = 18
.Width = 48
.AddItem "xlWhole"
.AddItem "xlPart"
.ListIndex = 1
.SpecialEffect = fmSpecialEffectEtched
.BackStyle = fmBackStyleOpaque
.ForeColor = &H808000
.BackColor = &H80000018
End With
With CommandButton1
.Left = 108
.Top = 78
.Height = 18
.Width = 66
.Caption = "Find"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With CommandButton2
.Left = 174
.Top = 78
.Height = 18
.Width = 66
.Caption = "FindNext"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
With CommandButton3
.Left = 240
.Top = 78
.Height = 18
.Width = 66
.Caption = "FindPrevious"
.BackStyle = fmBackStyleTransparent
.ForeColor = &H808000
End With
End With
End Sub
Private Sub Bellek_Kur()
On Error Resume Next
Bellek(1, 1) = " 1.Amazon River - 6.144.727 km² "
Bellek(2, 1) = " 2.Kongo River - 3.730.474 km²"
Bellek(3, 1) = " 3.Nil River - 3.254.555 km²"
Bellek(4, 1) = " 4.Mississippi River - 3.202.230 km²"
Bellek(5, 1) = " 5.Obi River - 2.972.497 km²"
Bellek(6, 1) = " 6.Parana River - 2.582.672 km²"
Bellek(7, 1) = " 7.Yenisey River - 2.554.482 km²"
Bellek(8, 1) = " 8.Çad Gölü - 2.497.918 km²"
Bellek(9, 1) = " 9.Lena River - 2.306.772 km²"
Bellek(10, 1) = " 10.NijSinter River - 2.261.763 km²"
Bellek(11, 1) = " 11.Amur River - 1.929.981 km²"
Bellek(12, 1) = " 12.Mackenzie River - 1.743.058 km²"
Bellek(13, 1) = " 13.Yang-Çe River - 1.722.155 km²"
Bellek(14, 1) = " 14.Volga River - 1.410.994 km²"
Bellek(15, 1) = " 15.Zambezi River - 1.332.574 km²"
Bellek(16, 1) = " 16.Tarim River - 1.152.447 km²"
Bellek(17, 1) = " 17.Nelson River - 1.093.442 km²"
Bellek(18, 1) = " 18.Sint River - 1.081.733 km²"
Bellek(19, 1) = " 19.St. Lawrence River - 1.049.621 km²"
Bellek(20, 1) = " 20.Murray River - 1.072.000 km²"
Bellek(21, 1) = " 21.Ganj River - 1.016.104 km²"
Bellek(22, 1) = " 22.Orinoko River - 953.598 km²"
Bellek(23, 1) = " 23.Huang He - 945.065 km²"
Bellek(24, 1) = " 24.Orange River - 941.421 km²"
Bellek(25, 1) = " 25.Yukon River - 847.642 km²"
Bellek(26, 1) = " 26.Mekong River - 805.627 km²"
Bellek(27, 1) = " 27.Tuna River - 795.686 km²"
Bellek(28, 1) = " 28.Seyhun - 782.669 km²"
Bellek(29, 1) = " 29.Dicle-Fırat Rivers - 765.831 km²"
Bellek(30, 1) = " 30.Tocantins River - 764.183 km²"
Bellek(31, 1) = " 31.Okavango River - 721.277 km²"
Bellek(32, 1) = " 32.Colorado River - 703.132 km²"
Bellek(33, 1) = " 33.Kolyma River - 679.908 km²"
Bellek(34, 1) = " 34.Columbia River - 657.490 km²"
Bellek(35, 1) = " 35.Brahmaputra River - 651.334 km²"
Bellek(36, 1) = " 36.São Francisco River - 617.812 km²"
Bellek(37, 1) = " 37.Rio Grande - 608.023 km²"
Bellek(38, 1) = " 38.Ceyhun River - 534.764 km²"
Bellek(39, 1) = " 39.Dinyeper River - 531.817 km²"
Bellek(40, 1) = " 40.Balkaş Gölü - 512.010 km²"
Bellek(41, 1) = " 41.Juba River - 497.655 km²"
Bellek(42, 1) = " 42.Don River - 458.703 km²"
Bellek(43, 1) = " 43.Limpopo River - 421.168 km²"
Bellek(44, 1) = " 44.Senegal River - 419.659 km²"
Bellek(45, 1) = " 45.Irrawaddy River - 413.674 km²"
Bellek(46, 1) = " 46.Pearl River - 409.458 km²"
Bellek(47, 1) = " 47.Colorado River - 402.956 km²"
With Sheets(1)
.Range("A1").Value = "River Name"
.Range("A2:A48").Value = Bellek()
End With
End Sub

'Module1

Option Explicit
Public Declare Function CLSIDFromString Lib "ole32" (ByVal lpstrCLSID As Long, lpCLSID As Any) As Long
Public Declare Function OleLoadPicturePath Lib "oleaut32" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As Any, ByRef ppvRet As Any) As Long
Public IPic(15) As Byte
Public Const ClsID As Variant = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Public Const URL1 As String = "http://2.bp.blogspot.com/-G3KDFVP7V0Q/TcUhtYtMifI/AAAAAAAACw0/Ta6mFpFJtZ8/s1600/39.bmp"
Public Const URL2 As String = "http://2.bp.blogspot.com/_hsHTxo_5L8E/S78EbvJyhRI/AAAAAAAACS0/txbOQ1qubg8/s1600/PB%C4%B0D_jpg.jpg"
Public URL As String
Sub Form_Aç()
On Error Resume Next
UserForm1.Show 0
End Sub
Public Function Resim(URL) As Picture 'Picture load frome web address...
On Error Resume Next
CLSIDFromString StrPtr(ClsID), IPic(0)
OleLoadPicturePath StrPtr(URL), 0&, 0&, 0&, IPic(0), Resim
End Function
'Sub References_List()
'On Error Resume Next
'Dim Eleman, No
'No = 1
'For Each Eleman In ThisWorkbook.VBProject.References
'Sheets(1).Cells(No, 1) = No & ") Name: "
'Sheets(1).Cells(No, 2) = Eleman.Name
'Sheets(1).Cells(No, 3) = ", Description: "
'Sheets(1).Cells(No, 4) = Eleman.Description
'Sheets(1).Cells(No, 5) = ", FullPath: "
'Sheets(1).Cells(No, 6) = Eleman.FullPath
'No = No + 1
'Next Eleman
'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