kapalı bir kaç dosyadan veri çağırma

[mehmethoca]

arkadaşlar makro bilmiyorum ama buradan gördüğüm bazı kodları kes yapıştır mantığı ile projelerimde kullanıyorum

sorum şu

bir klasörümüz olsun içerisinde ....xls ler olsun
benim bir sorgu ekranım olsun oraya öğrenci isimlerini yazayım kapalı olan bu dosyalar sıra ile taransın öğrencinin ismine rastladığında o satırı alsın gelsin ben çıktı alabileyim

arkadaşlar belki abartın diyebilirsiniz ve haklı da olabilirsiniz ama öyle şeyler yapıyorsunuz ki bunuda yaparsınız hissine kapıldım

ilgilenecek arkadaş olursa ben dosya isimlerini hatta her dosyada öğrenci isimlerinin bulunduğu stünları verebilirim

bu arada veriler hep sayfa 1 de

 

[altanson]

dosyalar kapalı iken makro çalıştırıp istediğiniz verileri çekip alabilecek bir makro varsa excel de yapılamayacak şey yok diyebilirim sanırım.

 

[mehmethoca]

Function CWRIA(fPath As String, fName As String, _
sName As String, rng As String)
Dim sRow As Integer
Dim sColumn As Integer
Dim sRows As Integer
Dim sColumns As Integer
Dim vrow As Integer
Dim vcol As Integer
Dim fpStr As String
Dim cArr()

On Error GoTo NoArr

If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
If Dir(fPath & fName) = "" Then
CWA = CVErr(xlErrValue)
Exit Function
End If

sRow = Range(rng).Row
sColumn = Range(rng).Column
sRows = Range(rng).Rows.Count
sColumns = Range(rng).Columns.Count
ReDim cArr(sRows, sColumns)

For vrow = 1 To sRows
For vcol = 1 To sColumns
fpStr = "'" & fPath & "[" & fName & "]" & sName & "'!" & _
"r" & sRow + vrow - 1 & "c" & sColumn + vcol - 1
cArr(vrow, vcol) = ExecuteExcel4Macro(fpStr)
Next
Next

CWRIA = cArr
Exit Function
NoArr:
CWRIA = CVErr(xlErrValue)
End Function

Sub CWRIR(fPath As String, fName As String, sName As String, _
rng As String, destRngUpperLeftCell As String )
Dim sRow As Integer
Dim sColumn As Integer
Dim sRows As Integer
Dim sColumns As Integer
Dim vrow As Integer
Dim vcol As Integer
Dim fpStr As String
Dim cArr()

On Error GoTo NoArr
If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
If Dir(fPath & fName) = "" Then
CWA = CVErr(xlErrValue)
Exit Function
End If
sRow = Range(rng).Row
sColumn = Range(rng).Column
sRows = Range(rng).Rows.Count
sColumns = Range(rng).Columns.Count
ReDim cArr(sRows, sColumns)
Set destRange = ActiveSheet.Range(destRngUpperLeftCell)
For vrow = 1 To sRows
For vcol = 1 To sColumns
fpStr = "'" & fPath & "[" & fName & "]" & sName & "'!" & _
"r" & sRow + vrow - 1 & "c" & sColumn + vcol - 1
destRange.Offset(vrow - 1, vcol - 1) = ExecuteExcel4Macro(fpStr)
Next
Next
NoArr:
End Sub

Sub InsertRangeFromClosedWorkbook()
CWRIR "D:\EXCEL97\xlformulas", "cellDataVal.xls", "Sheet1", "a1:c3", "f9"
End Sub

b&#246;yle birtak&#305;m kodlar var ama ne i&#351;e yar&#305;yorlar anlam&#305;yorum

 

[Haluk]

dosyalar kapalı iken makro çalıştırıp istediğiniz verileri çekip alabilecek bir makro varsa excel de yapılamayacak şey yok diyebilirim sanırım.

Kapalı dosya uygulamaları

 

[altanson]

Kapalı dosya uygulamaları

kısa süredir bu forumdayım ve exceli hesap makinası gibi kullandığımı öğrendim.

çok teşekkürler.

 

[Orion1]

kısa süredir bu forumdayım ve exceli hesap makinası gibi kullandığımı öğrendim.

Siz gene şanslısınız.Ben gene daktilo gibi kullanıyormuşum.

 

[mehmethoca]

say&#305;n sezar siz b&#246;yle diyorsan&#305;z ben hi&#231; ba&#351;lam&#305;yay&#305;m

excelin benim i&#231;in abak&#252;sten fark&#305; yok o zaman

 

[Skorpiyon]

Say&#305;n Evren Gizlen, altanson ve mehmethoca,

Sizin bu mesajlar&#305;n&#305; g&#246;rd&#252;&#287;&#252;mde g&#252;lmeden edemedim. Ve bende maalesef hesap makinesi gibi kulland&#305;&#287;&#305;m g&#252;nleri an&#305;msad&#305;m. &#350;imdi ise daktilo gibi kullanmaya terfi ettim diyebilirim