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
End Sub