Kapalı dosyanın korumasını kaldırma ve formül güncelleme

Kumpasta · 6 Aralık 2022

İyi günler. GÜnaydın.
Bir klasörde bulunan 200 e yakın klon dosyanın tüm hücreleri, hücrelerdeki formülleri birebir aynı. Sayfa isimleri bile aynı. Hepsi aynı klasörde bulunuyor.
Tüm klon dosyaların sayfa koruma şifreleri aynı.
Bir klon dosya üzerinde yapılan değişikliği kaydet butonu ile diğer klonlara uygulatmak istiyorum. Mesela tablo başlıkları yada tabloların altında ki formüller.... gibi değişiklikleri değiştirici dosya ile tek seferde yapmak istiyorum.
Her tablonun en sağında birer buton var. bu butona basında kendi hizasındaki tabloları o klasördeki tüm dosyalarda güncellemesini istiyorum.
koruma parolası 1234

İndir ÖrneK rar

Dosyayı indir ÖrneK rar

dosya.co

Kumpasta · 7 Aralık 2022

İyi günler. Akıl veya destek verebilecek var mı?

Kumpasta · 8 Aralık 2022

Konu günceldir iyi akşamlar.

Kumpasta · 9 Aralık 2022

Şu kodu kendime uyarlamaya çalıştım fakat başaramadım.

C++:

Option Explicit

Sub Klasordeki_Dosyalari_Guncelle()
    Dim Klasor As Object, Kaynak_Klasor As String, Excel_Dosyasi As String, Dosya As Workbook
 
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Kaynak dosyaları içeren klasörü seçiniz...", 50, &H0)
 
    If Klasor Is Nothing Then
        MsgBox "İşleme devam edbilmek için klasör seçimi yapmalısınız!" & Chr(10) & _
        "İşleminiz iptal edilmiştir.", vbCritical
        Exit Sub
    ElseIf Klasor = "Masaüstü" Or Klasor = "Desktop" Then
        Kaynak_Klasor = Environ("UserProfile") & "\Desktop\"
    ElseIf Not Klasor Is Nothing Then
        Kaynak_Klasor = Klasor.Items.Item.Path
    End If
 
    On Error Resume Next
 
    Excel_Dosyasi = Dir(Kaynak_Klasor & "\*.xls*")
 
    Application.ScreenUpdating = False
 
    Do
        If Excel_Dosyasi <> "" And Excel_Dosyasi <> ThisWorkbook.Name Then
            DoEvents
            Application.DisplayAlerts = False
            Set Dosya = Workbooks.Open(Kaynak_Klasor & "\" & Excel_Dosyasi, True)
            Application.DisplayAlerts = True
            Dosya.Close True
            Excel_Dosyasi = Dir
        Else
            Excel_Dosyasi = Dir
        End If
    Loop While Excel_Dosyasi <> ""
 
    Set Dosya = Nothing
    Set Klasor = Nothing
 
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

necati · 9 Aralık 2022

Merhaba,
Q4 deki tablo için örnek kod:

Kod:

Sub test()
'Q4 deki tablo için örnek
Dim yol As String, dosya As String

    yol = "C:\Test\"    'dosya yolunu belirleyiniz.
    Application.ScreenUpdating = False
    dosya = Dir(yol & "*.xls*")
        Do While dosya <> ""
        
            If dosya = ThisWorkbook.Name Then
                GoTo gec:
            End If
        
            Range("Q4:V17").Copy
            Workbooks.Open yol & dosya
            ActiveSheet.Unprotect Password:="1234"

            Range("Q4").PasteSpecial
            
            ActiveWorkbook.Save
            ActiveSheet.Protect Password:="1234"
            ActiveWorkbook.Close
gec:
            dosya = Dir()
        Loop
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "İşleminiz Bitti.", vbInformation
End Sub

Kumpasta · 10 Aralık 2022

Yardım için teşekkür ederim.
Şu kodlarda hata verdi: runtime error 1004 method open of object workbooks failed
Workbooks.Open yol & dosya
Amacım : belirli bir hücredeki formülü olduğu gibi tüm dosyalarda sayfa korumasını kaldırarak hücreye yapıştırmak ve tekrar sayfa koruma şifresi ile kaydedip kapatmak.

necati · 10 Aralık 2022

Yol ismini kendinize göre uyarladınız değil mi?
Makro hiç bir dosyayı mı açmadı, yoksa bazı dosyaları açıp çalıştı mı?

Kumpasta · 10 Aralık 2022

evet uyarladım ama hiç çalışmadan bu hatayı verdi.

necati · 10 Aralık 2022

"Application.DisplayAlerts = False" yaparak deneyelim.

Kod:

Sub test()
'Q4 deki tablo için örnek
Dim yol As String, Dosya As String

    yol = "C:\Test\"    'dosya yolunu belirleyiniz.
    Application.ScreenUpdating = False
    Dosya = Dir(yol & "*.xls*")
        Do While Dosya <> ""
        
            If Dosya = ThisWorkbook.Name Then
                GoTo gec:
            End If
        
            Range("Q4:V17").Copy
            Application.DisplayAlerts = False
            Workbooks.Open yol & Dosya
            Application.DisplayAlerts = True
            ActiveSheet.Unprotect Password:="1234"

            Range("Q4").PasteSpecial
            
            ActiveWorkbook.Save
            ActiveSheet.Protect Password:="1234"
            ActiveWorkbook.Close
gec:
            Dosya = Dir()
        Loop
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "İşleminiz Bitti.", vbInformation
End Sub

Kumpasta · 10 Aralık 2022

Yİne bu hatayı veriyor aynı satırda.
runtime error 1004 method open of object workbooks failed

Eğer yol isminin sonuna "\" koymazsam, hemen işlem yapmadığı halde işlem bitti uyarısı çıkıyor.

necati · 10 Aralık 2022

O "\" karakteri koymamız lazım, konulmazsa klasör yolu eksik kalır.
Sizin kendi verdiğiniz örneği denediğinizde ilk dosya açılıyor muydu?

Kumpasta · 10 Aralık 2022

Yok hayır o zaten hiç çalışmadı

necati · 10 Aralık 2022

Çalışıyor da içinde bir aksiyon yok. Aç/kapa yapılmış. Bir de o kodu size uyarlayalım:

Kod:

Sub Klasordeki_Dosyalari_Guncelle()
    Dim Klasor As Object, Kaynak_Klasor As String, Excel_Dosyasi As String, Dosya As Workbook
 
    Set Klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Kaynak dosyaları içeren klasörü seçiniz...", 50, ThisWorkbook.Path)
 
    If Klasor Is Nothing Then
        MsgBox "İşleme devam edbilmek için klasör seçimi yapmalısınız!" & Chr(10) & _
        "İşleminiz iptal edilmiştir.", vbCritical
        Exit Sub
    ElseIf Klasor = "Masaüstü" Or Klasor = "Desktop" Then
        Kaynak_Klasor = Environ("UserProfile") & "\Desktop\"
    ElseIf Not Klasor Is Nothing Then
        Kaynak_Klasor = Klasor.Items.Item.Path
    End If
 
    On Error Resume Next
 
    Excel_Dosyasi = Dir(Kaynak_Klasor & "\*.xls*")
 
    Application.ScreenUpdating = False
 
    Do
        If Excel_Dosyasi <> "" And Excel_Dosyasi <> ThisWorkbook.Name Then
            DoEvents

            Range("Q4:V17").Copy
            Application.DisplayAlerts = False
            Set Dosya = Workbooks.Open(Kaynak_Klasor & "\" & Excel_Dosyasi, True)
            Application.DisplayAlerts = True
            
            Dosya.Unprotect Password:="1234"

            Dosya.ActiveSheet.Range("Q4").PasteSpecial
            
            Dosya.Protect Password:="1234"
            Dosya.Save
            Dosya.Close
            Excel_Dosyasi = Dir
        Else
            Excel_Dosyasi = Dir
        End If
    Loop While Excel_Dosyasi <> ""
 
    Set Dosya = Nothing
    Set Klasor = Nothing
 
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Kumpasta · 10 Aralık 2022

Çok uğraştırdım fakat olmuyor. Ne parola açılıyor nede belirttiğim hücredeki formül ilgili dosyalara taşınıyor.
2 - 3 dakika bekleyip işlem bitti diyor ama açıp bakınca hiç bir şey değişmemiş gibi

necati · 10 Aralık 2022

Forum arkadaşlarımızdan "runtime error 1004 method open of object workbooks failed" hatası ile ilgili fikri olan paylaşabilirse memnun olurum.

Korhan Ayhan · 10 Aralık 2022

Paylaştığınız örnek dosyalarda sayfa koruması sanırım 1234 değil.

Kumpasta · 12 Aralık 2022

Evet haklısınız 1234 değil 2142542 olacaktı.

Korhan Ayhan · 12 Aralık 2022

Önerilen kodlarda koruma şifrelerini değiştirip deneyerek sonucu kontrol edebilirsiniz.

Kapalı dosyanın korumasını kaldırma ve formül güncelleme

Kumpasta

İndir ÖrneK rar

Kumpasta

Kumpasta

Kumpasta

necati

Kumpasta

necati

Kumpasta

necati

Kumpasta

necati

Kumpasta

necati

Kumpasta

necati

Korhan Ayhan

Administrator

Kumpasta

Korhan Ayhan

Administrator