Vb üzerinden excelde arama yapmak

[AcimasiZz-]

HERAKLES Otomatik Avlı kalıcı sunucu. 19 Haziran'da açılıyor. Atius & Wizard güvencesiyle hemen kayıt ol, ön kayıt ödülleri aktif. HEMEN TIKLA!

Kod:
 Project/References menülerinden "Microsoft Excel 10.0 Object Library" ekleyin,

Formunuza 9 adet text kutusu, 9 adet label ve bir adet command butonu ekleyin,

ve aşağıdaki kodları olduğu gibi forma yapıştırın ve çalıştırın.

Dim c As Excel.Range
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet


Sub ExcelAra()
On Error GoTo hata
Set xlApp = New Excel.Application

Text2.Text = ""

Set xlBook = Workbooks.Open(App.Path & "\devlet_kurumlari.xls", , True)
Set xlSheet = xlBook.Worksheets("sheet 1")


With xlSheet.Range("a1:c65536")
Set c = .Find(Trim(Text1.Text), lookin:=xlValues)
If Not c Is Nothing Then

firstAddress = c.Address

Text2.Text = c.Address


Range(Text2.Text).Select
Text3.Text = Excel.ActiveCell.Row

'??????_______Kurum Adı
Range("$d$" & Text3.Text).Select
Text4.Text = Excel.ActiveCell

'??????_______Kurum İli
Range("$a$" & Text3.Text).Select
Text5.Text = Excel.ActiveCell

'??????_______Kurum İlçesi
Range("$b$" & Text3.Text).Select
Text6.Text = Excel.ActiveCell

'??????_______Kurum Telefonu
Range("$e$" & Text3.Text).Select
Text7.Text = Excel.ActiveCell
MaskEdBox1.Text = Excel.ActiveCell
'??????_______Kurum Fax
Range("$f$" & Text3.Text).Select
Text8.Text = Excel.ActiveCell

'??????_______Kurum Adres
Range("$g$" & Text3.Text).Select
Text9.Text = Excel.ActiveCell



Do
c.Interior.Pattern = xlPatternGray50
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

If Text2.Text = "" Then Text2.Text = "Bulunamadı..."




xlBook.Close False
xlApp.Quit

Exit Sub
hata:
MsgBox Err.Description

End Sub

Private Sub Command1_Click()
ExcelAra

 

[turkmmouser03]

Teşşekurler . Kaliteli Bir Konu Olmuş .