Kapalı excel dosyasından herhangi bir veriyi çekmek

[zuzazu]

Merhaba;
Benim bir excel dosyam var adı hesap.xlsx olsun ve onunla aynı klasörde 1.xlsx , 2.xlxx gibi farklı excel dosyalarım var. Ben bu 1 ve 2 dosyaları açık değilken herhangi bir kutucuktan hesap.xlsx dosyasına =[1.xlsx]Sayfa1!A1 formülüyle veri çekmek istiyorum. Çünkü çekeceğim verilerin yerleri sürekli değişebiliyor bana bu konuda acil yardım ederseniz çok sevinirim.

Yardımınız için şimdiden çok teşekkur ederim.

 

[Korhan Ayhan]

Merhaba,

Forumda "ExecuteExcel4Macro" ifadesi ile arama yapıp inceleyin.

 

[zuzazu]

Forumda bu konuyla ilgili hemen hemen her konuyu inceledim zaten. Hep belirli satır yada sütunlar için çözümler verilmiş. Ben tamamı için geçerli olabilcek bir çözüm olup olmadığını merak ediyorum.

 

[Korhan Ayhan]

Merhaba,

Örnek dosya ekleyerek nasıl bir uygulama yapmak istediğinizi açıklarmısınız.

 

[Korhan Ayhan]

Merhaba,

Ben kendimce bir örnek hazırladım. Ekteki dosyaları indirin. Masaüstüne çıkarın.

Klasör içindeki ANA_DOSYA isimli dosyada herhangi bir sayfada herhangi bir hücreye çift tıklayın. Karşınıza bir form gelecek. Bu formdan ilk önce bir klasör seçmeniz gerekiyor. Seçtiğiniz klasör altındaki dosyalar ListBox1 de listelenir. Seçeceğiniz dosya adına göre ListBox2 de sayfalar listelenir. Dosya ve sayfa seçimini tamamladıktan sonra aktarmak istediğiniz hücre adresini belirlemeniz gerekiyor. Adres seçiminide yaptıktan sonra AKTAR tuşuna basarak veri aktarımını tamamlamış olursunuz. Eğer aktarılan hücre boş veya sıfır değeri içeriyorsa boş olarak aktarılacaktır.

 

[halit3]

Merhaba,

Ben kendimce bir örnek hazırladım. Ekteki dosyaları indirin. Masaüstüne çıkarın.

Klasör içindeki ANA_DOSYA isimli dosyada herhangi bir sayfada herhangi bir hücreye çift tıklayın. Karşınıza bir form gelecek. Bu formdan ilk önce bir klasör seçmeniz gerekiyor. Seçtiğiniz klasör altındaki dosyalar ListBox1 de listelenir. Seçeceğiniz dosya adına göre ListBox2 de sayfalar listelenir. Dosya ve sayfa seçimini tamamladıktan sonra aktarmak istediğiniz hücre adresini belirlemeniz gerekiyor. Adres seçiminide yaptıktan sonra AKTAR tuşuna basarak veri aktarımını tamamlamış olursunuz. Eğer aktarılan hücre boş veya sıfır değeri içeriyorsa boş olarak aktarılacaktır.

Korhan bey elinize sağlık bendede bun benzer bir kod vardı ama çok uzundu.

bu kod daha kısaymış çalışmalarımda inşallah kullanacağım.

Dim Katalog As Object, Data As Object, Tablo As Object
Set Data = CreateObject("ADODB.Connection")
Set Katalog = CreateObject("ADOX.Catalog")
Dosya_Adı = ListBox1.Value
Data.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & Dosya_Yolu & "\" & Dosya_Adı & ";"
Katalog.ActiveConnection = Data
ListBox2.Clear
For Each Tablo In Katalog.Tables
If Tablo.Type = "SYSTEM TABLE" Then
ListBox2.AddItem Left$(Tablo.Name, Len(Tablo.Name) - 1)
End If
Next
Set Data = Nothing
Set Katalog = Nothing

 

[Korhan Ayhan]

Merhaba,

Halit bey evet daha kısa bir kod. Daha önce Zeki bey forumda yayınlamıştı. Bende arşivime almıştım. Kod bu haliyle adında boşluk olan sayfa isimlerini listelemiyor. Bu sorunu aşmak için kod içinde geçen aşağıdaki satırı bir sonraki gibi değiştirmek yeterli oluyor.

If Tablo.Type = "SYSTEM TABLE" Then

If Instr(1, Tablo.Type, "TABLE") > 0 Then

Fakat bu durumda bir problem daha oluşuyor. O da filtreler ve ad tanımlamaları. Bunlarda bu kod tarafından sayfa adı gibi algılanıp listeleniyor.

Bence bunun yerine dosyaları açıp sayfa isimlerini alsak daha sağlıklı olacak.

 

[halit3]

Merhaba,

Halit bey evet daha kısa bir kod. Daha önce Zeki bey forumda yayınlamıştı. Bende arşivime almıştım. Kod bu haliyle adında boşluk olan sayfa isimlerini listelemiyor. Bu sorunu aşmak için kod içinde geçen aşağıdaki satırı bir sonraki gibi değiştirmek yeterli oluyor.

If Tablo.Type = "SYSTEM TABLE" Then

If Instr(1, Tablo.Type, "TABLE") > 0 Then

Fakat bu durumda bir problem daha oluşuyor. O da filtreler ve ad tanımlamaları. Bunlarda bu kod tarafından sayfa adı gibi algılanıp listeleniyor.

Bence bunun yerine dosyaları açıp sayfa isimlerini alsak daha sağlıklı olacak.

Kodu bu şekilde değiştirdim. şimdilik bir sıkıntı gözükmüyor.

Private Sub ListBox1_Click()
Dim Katalog As Object, Data As Object, Tablo As Object
Dim son1
Set Data = CreateObject("ADODB.Connection")
Set Katalog = CreateObject("ADOX.Catalog")
Dosya_Adı = ListBox1.Value
ListBox2.Clear
Data.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & Dosya_Yolu & "\" & Dosya_Adı & ";"
Katalog.ActiveConnection = Data
For Each Tablo In Katalog.Tables
If InStr(1, Tablo.Type, "TABLE") > 0 Then
If Right(Tablo.Name, 19) <> "kaynağından_sorgula" Then
If Right(Tablo.Name, 14) <> "Yazdırma_Alanı" Then
son1 = Replace(Tablo.Name, "'", "")
If Right(son1, 1) <> "_" Then
ListBox2.AddItem Left$(son1, Len(son1) - 1)
End If
End If
End If
End If
Next
Set Data = Nothing
Set Katalog = Nothing
End Sub

 

[asdfwqrx]

özür dilerim ama ben yanlış bişey mi yapıyorum anlamadım ana sayfaya verileri çekmek için tarif ettiğiniz herşey yapıyorum "veri aktarımı tamamlanmıştır" diyor fakat ben göremiyorum.

 

[Korhan Ayhan]

Merhaba,

#5 nolu mesajımdaki dosyayı güncelledim. İncelermisiniz.

 

[halit3]

kod

Private Sub ListBox1_Click()
Dim Katalog As Object, Data As Object, Tablo As Object
Dim son1
Set Data = CreateObject("ADODB.Connection")
Set Katalog = CreateObject("ADOX.Catalog")
Dosya_Adı = ListBox1.Value
ListBox2.Clear
Data.Open "Driver={Microsoft Excel Driver (*.xls)};Dbq=" & Dosya_Yolu & "\" & Dosya_Adı & ";"
Katalog.ActiveConnection = Data
For Each Tablo In Katalog.Tables
If InStr(1, Tablo.Type, "TABLE") > 0 Then
If Right(Tablo.Name, 19) <> "kaynağından_sorgula" Then
If Right(Tablo.Name, 14) <> "Yazdırma_Alanı" Then
son1 = Replace(Tablo.Name, "'", "")
If Right(son1, 1) <> "_" Then
If Right(son1, 1) = "$" Then
ListBox2.AddItem Left$(son1, Len(son1) - 1)
End If
End If
End If
End If
End If
Next
Set Data = Nothing
Set Katalog = Nothing
End Sub

 

[Korhan Ayhan]

Merhaba,

Halit bey eklediğiniz son kod istenilen sonucu veriyor. Desteğiniz için teşekkür ederim.

Ekteki örnek dosyaya sizin verdiğiniz kodu düzenleyerek ekledim. Şimdi gayet güzel çalışıyor.