kapalı cari dosyalarında otomatik veri alma

[İhsan Tank]

s.a.
arkadaşlar ben cari hesap takibi yaptığım bir icmal var ve bunu otomatik oluşturmak istiyorum.
ekte iki tane dosya mevcut genel adlı dosyada

AASATIŞ FATURALARI CARİ BAKİYELER

bu adlı dosyada formülle yaptığım işlemi otomatik yapmak istiyorum.
ben bu işlemi yapmak için mecburen iki dosyada açık oluyor ve formülleri ona göre yazıyorum. bunu ben yeni bir dosya eklediğimde otomatik dosyaya eklemesini istiyorum

 

[halit3]

s.a.
arkadaşlar ben cari hesap takibi yaptığım bir icmal var ve bunu otomatik oluşturmak istiyorum.
ekte iki tane dosya mevcut genel adlı dosyada bu adlı dosyada formülle yaptığım işlemi otomatik yapmak istiyorum.
ben bu işlemi yapmak için mecburen iki dosyada açık oluyor ve formülleri ona göre yazıyorum. bunu ben yeni bir dosya eklediğimde otomatik dosyaya eklemesini istiyorum

Bunu denermizin

Dim sat As String
Private Sub CommandButton2_Click()
Range("A4:B65000").ClearContents
sat = 3
Dim Kaynak$, Dosyalar$
On Error Resume Next
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.browseforfolder(0, Baslik, 50, &H0)
Kaynak = Klasor.Items.Item.Path
If Kaynak = "" Then
MsgBox "Kaynak klasörü seçmediniz"
Exit Sub
End If
Dosyalar = "*.**"
If Dosyalar = "" Then
MsgBox "Uzantı seçmediniz.?"
Exit Sub
End If
Klasorler Kaynak, "*.*" & Dosyalar
MsgBox "işlem tamam"
End Sub
Sub Klasorler(Kaynak, Dosyalar)
Dim Dosya, Wdhlg, Yol As String
On Error Resume Next
If Right(Kaynak, 1) <> "\" Then
Kaynak = Kaynak & "\"
Klasor_adı = Kaynak
yer = Kaynak
Else
yer = Kaynak
Klasor_adı = Kaynak
End If

Dosya = Dir(Kaynak & Dosyalar)
Do While Len(Dosya)
If ThisWorkbook.Name <> Dosya Then
sat = Cells(Rows.Count, "b").End(3).Row + 1
deg = "'" & Kaynak & "[" & Dosya & "]" & 1 & "'!R"
Worksheets(ActiveSheet.Name).Cells(sat, "a") = ExecuteExcel4Macro(deg & 4 & "C" & 8)
Worksheets(ActiveSheet.Name).Cells(sat, "b") = ExecuteExcel4Macro(deg & 3 & "C" & 8)
Worksheets(ActiveSheet.Name).Cells(sat, "d") = Dosya
End If
Dosya = Dir()
Loop
Dosya = Dir(Kaynak, vbDirectory)
Do While Len(Dosya)
If (Dosya <> ".") And (Dosya <> "..") Then
If (GetAttr(Kaynak & Dosya) And vbDirectory) = vbDirectory Then
Klasorler Kaynak & Dosya, Dosyalar
Wdhlg = Dir(Kaynak, vbDirectory)
Do While Wdhlg <> Dosya
Wdhlg = Dir()
Loop
End If
End If
Dosya = Dir()
Loop
End Sub

 

[İhsan Tank]

Bunu denermizin

hocam çok teşekkür ederim
mükemmel çalışıyor

 

[halit3]

hocam çok teşekkür ederim
mükemmel çalışıyor

İyi çalışmalar

 

[İhsan Tank]

Bunu denermizin

hocam dosyadaki commanbutton2 düğmesi otomatik olamaz mı_?
diğer makro ile seçilen adresteki bilgileri getirsin.
yani module kod'unu çalıştırdıktan sonra aynı adres commanbutton2'deki kod'a otomatik tanımlansın.

 

[halit3]

hocam dosyadaki commanbutton2 düğmesi otomatik olamaz mı_?
diğer makro ile seçilen adresteki bilgileri getirsin.
yani module kod'unu çalıştırdıktan sonra aynı adres commanbutton2'deki kod'a otomatik tanımlansın.

Dosyada Bul1 ve Bul2 düğmeleri var Bul1 düğmesi ile dosyanın yerini buluyorsun ve verileri alıyorsun bundan sonra aynı işlemi yapmak için Bul2 düğmesine tıklıyorsun ve hiç bir uyarı gelmeden en son hangi klasörden veri aldıysanız o klasörden kendisi verileri alıyor.

 

[İhsan Tank]

Dosyada Bul1 ve Bul2 düğmeleri var Bul1 düğmesi ile dosyanın yerini buluyorsun ve verileri alıyorsun bundan sonra aynı işlemi yapmak için Bul2 düğmesine tıklıyorsun ve hiç bir uyarı gelmeden en son hangi klasörden veri aldıysanız o klasörden kendisi verileri alıyor.

hocam Bul1'deki kod

Set kod = ThisWorkbook.VBProject.VBComponents("Module1").CodeModule

bu satırda hata veriyor

 

[halit3]

6 nolu mesajdaki dosyayı güncelledim klasörün yolunu kendinize göre değiştirin.

Kaynak = "C:\deneme" 'dosya yolu buraya yazılacak

 

[İhsan Tank]

6 nolu mesajdaki dosyayı güncelledim klasörün yolunu kendinize göre değiştirin.

teşekkür ederim hocam

 

[halit3]

teşekkür ederim hocam

İyi çalışmalar İhsan Bey