sayfa koruma

[kesikbey]

Arkadaşlar ekte gönderdiğim dosyada "RAPOR " sayfasının formül kısmına koruma koymak istiyorum. Yeşil bölge açık olsun ki, sonradan değer girebilelim.

birde desen sütununa eklediğim veri doğrulama seç ile veri istediğimde siliniyor, nasıl bir veri aktarımı yapalım ki RAPOR SAYFASINDAKİ VERİ DOĞRULAMA SİLİNMESİN. bİR ÇÖZÜMÜ VARSA YARDIMINIZI BEKLERİM.

İLGİLENEN ARKADAŞLARA ŞİMDİDEN TEŞEKKÜRLER...
BU PROBLEMİ OFİS 2003 TE BİÇİMLENDİR KISMINDAN ÇÖZÜYORDUM FAKAT 2007 DE OLMADI...

 

[Ömer]

Merhaba,

Koruma için linki inceleyiniz.

Formülleri Korumak (Video)

Doğrulamaların silinmemesi için ise, formadaki,

Range("B5:k" & Rows.Count).Clear

yukarıda yazdığım kod satırını aşağıdakiyle değiştirin.

Range("B5:k" & Rows.Count).ClearContents

.

 

[kesikbey]

bUNU DENEYECEM
AMA BİR SORUNUMDA
YENİ VERİ ALDIĞIMDA SÜTUN DAKİ VERİ DOĞRULAMAYI SİLİYOR

 

[Ömer]

Bununla ilgili kodları üsteki mesajımda yazmıştım.

 

[kesikbey]

öMER KARDEŞİM TEŞEKKÜRLER,
VERİ DOĞRULAMA İŞİ TMM
ŞİMDİ TEK EKSİĞİM
"r1:t" deki hücreleri korunsun
"B5:K" HÜCRELERİ SERBEST OLSUN

 

[kesikbey]

bOŞ GELEN pARSELLERİ ÜCRETLENDİRMEK İÇİN DİREK OLARAK DESENİ GİRMEM LAZIM
LİSTE SEÇİYOR AMA KORUMA İZİN VERMİYOR

 

[Ömer]

Korumayla ilgili detaylı bilgiyi verdiğim linkte bulabilirsiniz.

Daha sonra kodları aşağıdakilerle değiştirin.

şifreniz bölümünü kendinizinkiyle değiştirirsiniz.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
ActiveSheet.Unprotect "[COLOR=red]şifreniz[/COLOR]"
Dim sat As Long, sh As Worksheet, sf()
Sheets("RAPOR").Select
ActiveSheet.Unprotect
Range("F1").Value = isimbox.Value
Range("B5:k" & Rows.Count).ClearContents
Application.ScreenUpdating = False
sf = Array("", "msh", "SATIŞ", "KASA")
For i = 1 To 3
    Set sh = Sheets(sf(i))
    sh.Range("B4").AutoFilter
    sh.Range("B4").AutoFilter field:=2, Criteria1:=isimbox.Text & "*"
    If WorksheetFunction.Subtotal(103, sh.Range("B2:B" & sh.Rows.Count)) > 0 Then
        sat = Cells(Rows.Count, "B").End(xlUp).Row + 1
        sh.Range("B4").CurrentRegion.Offset(1, 0).Copy
        Range("B" & sat).PasteSpecial (xlPasteValuesAndNumberFormats)
    End If
    Application.CutCopyMode = False
    sh.Range("B4").AutoFilter
    Set sh = Nothing
Next i
Application.ScreenUpdating = True
Range("A5:A300").Select
Range("A5:A300").Cells.ClearContents
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Unload Me
'MsgBox "İşlem tamamlanmıştır." & vbLf & "[EMAIL="senolsolaka@hotmail.com"]senolsolaka@hotmail.com[/EMAIL]", vbOKOnly + vbInformation
ActiveSheet.Protect "[COLOR=red]şifreniz[/COLOR]"
End Sub

.

 

[kesikbey]

kardeş çok teşekkürler,
tam istediğim gibi
allah senden razı olsun... iyi geceler