Project/References menulerinden "Microsoft Excel 10.0 Object Library" ekleyin,

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

ve asagidaki kodlari oldugu gibi forma yapistirin ve calistirin.

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

'gggggg_______Kurum Adi
Range("$d$" & Text3.Text).Select
Text4.Text = Excel.ActiveCell

'gggggg_______Kurum gli
Range("$a$" & Text3.Text).Select
Text5.Text = Excel.ActiveCell

'gggggg_______Kurum glcesi
Range("$b$" & Text3.Text).Select
Text6.Text = Excel.ActiveCell

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

'gggggg_______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 = "Bulunamadi..."




xlBook.Close False
xlApp.Quit

Exit Sub
hata:
MsgBox Err.Description

End Sub

Private Sub Command1_Click()
ExcelAra
End Sub