Klasördeki kapalı excel dosyaların hepsinde makro çalıştırma

[unutkan518]

Merhaba

Bir klasör içindeki kapalı durumda olan excel dosyalarında belirli bir makro çalıştırmak istiyorum.
Bu makro bazen değişebiliyor bu yüzden kapalı dosyarın hepsinde yazdığım makronun çalışması için
yardımcı olabilirseniz sevinirim.

Örnek

sub kapalımakro ()
.
.
.
.
çalışacak makro
.
.
.
end sub

 

[Korhan Ayhan]

Bunun için kapalı dosyaları açmanız gerekecektir.

 

[unutkan518]

Bunun için kapalı dosyaları açmanız gerekecektir.

Korhan Bey
örnek bir kod bloğu verme imkanınız varmı acaba

 

[Korhan Ayhan]

Deneyiniz.

Kendinize uyarlamanız gerekebilir.

Option Explicit

Sub Klasor_Altındaki_Dosyalarda_Makro_Calistir()
    Dim K1 As Workbook, K2 As Workbook, S1 As Worksheet, Zaman As Double
    Dim Hedef_Dosya As Variant, Makrolu_Dosya As Variant, X As Integer
   
    Makrolu_Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyası, *.xls; *.xlsb; *.xlsm", MultiSelect:=False)
   
    If Makrolu_Dosya = False Then
        MsgBox "İşleme devam edebilmeniz için makro içeren dosyanızı seçmelisiniz!", vbCritical
        Exit Sub
    End If
   
    Hedef_Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyası, *.xls; *.xlsb; *.xlsx; *.xlsm", MultiSelect:=True)
   
    If IsArray(Hedef_Dosya) = False Then
        MsgBox "İşleme devam edebilmeniz için makronun çalıştırılacağı dosyaları seçmelisiniz!", vbCritical
        Exit Sub
    End If
   
    Zaman = Timer
   
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
   
    Set K1 = Workbooks.Open(Makrolu_Dosya)
   
    For X = LBound(Hedef_Dosya) To UBound(Hedef_Dosya)
        Set K2 = Workbooks.Open(Hedef_Dosya(X))
        Set S1 = K2.Sheets("Sheet1")
       
        Application.Run "'" & K1.FullName & "'!Makronuzun_Adi"
                
        K2.Close True
    Next
   
    K1.Close False
    
    Set K1 = Nothing
    Set K2 = Nothing
    Set S1 = Nothing
   
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
   
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[Erdem Akdemir]

Kapalı dosyadan veri alarak sorunu çözebilirsiniz. Ayrıca makro çalıştırmaya gerek olmayabilir.

 

[unutkan518]

Deneyiniz.

Kendinize uyarlamanız gerekebilir.

Option Explicit

Sub Klasor_Altındaki_Dosyalarda_Makro_Calistir()
    Dim K1 As Workbook, K2 As Workbook, S1 As Worksheet, Zaman As Double
    Dim Hedef_Dosya As Variant, Makrolu_Dosya As Variant, X As Integer
  
    Makrolu_Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyası, *.xls; *.xlsb; *.xlsm", MultiSelect:=False)
  
    If Makrolu_Dosya = False Then
        MsgBox "İşleme devam edebilmeniz için makro içeren dosyanızı seçmelisiniz!", vbCritical
        Exit Sub
    End If
  
    Hedef_Dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyası, *.xls; *.xlsb; *.xlsx; *.xlsm", MultiSelect:=True)
  
    If IsArray(Hedef_Dosya) = False Then
        MsgBox "İşleme devam edebilmeniz için makronun çalıştırılacağı dosyaları seçmelisiniz!", vbCritical
        Exit Sub
    End If
  
    Zaman = Timer
  
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
  
    Set K1 = Workbooks.Open(Makrolu_Dosya)
  
    For X = LBound(Hedef_Dosya) To UBound(Hedef_Dosya)
        Set K2 = Workbooks.Open(Hedef_Dosya(X))
        Set S1 = K2.Sheets("Sheet1")
      
        Application.Run "'" & K1.FullName & "'!Makronuzun_Adi"
               
        K2.Close True
    Next
  
    K1.Close False
   
    Set K1 = Nothing
    Set K2 = Nothing
    Set S1 = Nothing
  
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
  
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Yardımınız için çok teşekkür ederim. İyi günler