macroyu 1 den fazla sayfaya uygulama

[flamenker]

Slm dostlar

aşağıda yazılı makroyu tek sayfa için sıkıntısız kullanıyorum.kaydedip çıktıktan sonra data girilmiş hücreleri kilitliyor.
ama 3-4 sayfada kullanabilmem gerekli nasıl yapılır acaba
code:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim SH As Worksheet
Dim rng As Range
Const PWORD As String = "ABC" '<<=== CHANGE

Set SH = Me.Sheets("Sheet1") '<<=== CHANGE

With SH
.Unprotect Password:=PWORD
On Error Resume Next
Set rng = SH.Cells.SpecialCells(xlCellTypeConstants)
On Error GoTo 0

If Not rng Is Nothing Then
.Cells.Locked = False
rng.Cells.Locked = True
.Protect Password:=PWORD
End If
End With
End Sub

 

[Korhan Ayhan]

Selamlar,

Peki çalışmanızda bu kodu uygulamamanız gereken sayfa varmı?

 

[flamenker]

Slm

Aslında var ama hepsi için olsa da olur.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim SAYFA As Worksheet
    Dim HÜCRE As Range
    
    For Each SAYFA In Worksheets
    
        With SAYFA
            .Unprotect Password:="ABC"
            
            On Error Resume Next
            Set HÜCRE = .Cells.SpecialCells(xlCellTypeConstants)
            On Error GoTo 0
            
            If Not HÜCRE Is Nothing Then
            .Cells.Locked = False
            HÜCRE.Locked = True
            .Protect Password:="ABC"
            End If
        End With
        
    Next
End Sub

 

[flamenker]

range sınıfının lock özelliği kurulamıyor hatası aldım.
ilginize tşkkürler

 

[flamenker]

çoklu kullanım için bir siteden şöyle birşey buldum ama entehre edemiyorum vba bilgim yok.

Sub foo()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
' Exclude certain sheets
If ws.Name <> "Sheet1" Or ws.Name <> "Sheet2" Then
' Do your thing here
End If
Next ws
End Sub

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[flamenker]

Slm
Korhan Bey maalesef aynı hatayı alıyorum
Yalnız şunu belirteyim ki ki dosyada sayfalar isimlendirilmiş.
Bazı sayfalardaki hücreler kilitli bazıları değil.
ayrıca bir de fatura sayfası mevcut.Eğer macro bu sayfa içinde geçerli olursa 1 fatura kestikten sonra hücreleri kilitleyeceğinden işim oldukça zorlaşacak

 

[Korhan Ayhan]

Selamlar,

Dosyanızı ekleyin. Hangi sayfalar hangi koşula göre kilitlenecek belirtin. Ona göre kodu düzenleyelim.

 

[flamenker]

dosya

korhan bey ilginize gercekten tskkurler
fakat dosya 2 mb ı aşıyor o yüzden yükleyemedim.
başka bir yere yüklemeye çalışıp url vereceğim

 

[flamenker]

korhan bey
sadece "müşteri satış" ve ürün "stok giriş" sayfalarının veri girişi sonrası kaydedip çıktığımda dolu hücrelerin korunmasını istiyorum.Yani değişiklik yapılamasın.

Önceden de belirttiğim gibi verdiğim kod tek bir sayfa için bu işi çok iyi yapıyordu.

link:
http://www.upload.gen.tr/d.php/s6/uq51qvo7/cari_OZGU_2__3_.xls.html

direct link:
http://www.upload.gen.tr/d.php/s6/uq51qvo7/cari_OZGU_2__3_.xls.html

 

[Korhan Ayhan]

Selamlar,

Dosyanız korumalı, şifresini verebilirmisiniz.

Not: Foruma dosya eklerken lütfen şifrelerini kaldırın.

 

[flamenker]

kusura bakmayın unutmuşum

şifre 2456098

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim SAYFA As Worksheet
    Dim HÜCRE As Range
    
    For Each SAYFA In Worksheets
    
        If SAYFA.Name = "MÜŞTERİ SATIŞ" Or SAYFA.Name = "ÜRÜN STOK GİRİŞ" Then
        
        With SAYFA
            .Unprotect Password:="ABC"
            
            On Error Resume Next
            Set HÜCRE = .Cells.SpecialCells(xlCellTypeConstants)
            On Error GoTo 0
            
            If Not HÜCRE Is Nothing Then
            .Cells.Locked = False
            HÜCRE.Locked = True
            .Protect Password:="ABC"
            End If
        End With
        
        End If
    Next
End Sub

 

[flamenker]

tesekkurler

Korhan Bey,
Açıkçası pazar, pazar kimse uğraşmaz demiştim ama mecbur olmadığınız halde gösterdiğiniz emek ve sabır beni mahçup etti.
Kod tam olarak işimi gördü.
Ne kadar teşekkür etsem azdır.