Şifreli sayfaya veri aktarırken şifre soruyor bunu engelleyebilirmiyiz

[jambow]

ek dosyada örnek mevcut

iki sayfamız var şifreli -şifresiz verilerin aktarıldığı sayfa şifreli her veri aktardığımızda şifreyi soruyor .şifreyi manuel girmek yerine aktar makrosuna yazdırabilirmiyiz.
not:şifreyi kaldırmayacağız. sadece veri aktarırken şifre sormasın .

 

[Orion1]

Kendi kodlarınıza uayrlayınız.
Şifreli dosyayının şifresini kaldırarak korumayı kaldırı tekrar şifre korumalı yaparak şifre koyar.

Sheets("Sayfa1").unprotect "Şifreniz"
'------------
'------------------
'----------------
Sheets("Sayfa1").protect "Şifreniz"

 

[jambow]

ilginize teşekkür ancak verdiğiniz kod işe yaramadı şifreyi kaldırmıyor

Sub urunilave2()

YesNo = MsgBox("DİKKAT!!!! Stoklarınızı Bu düğmeye Basarak eklerseniz sadece ürünleri stoklara ekler .Fatura tutarını toptancının bakiyesine işlemez.?", vbYesNo + vbCritical, "Onaylıyormusun")
Select Case YesNo
Case vbYes



Set S1 = Sheets("stokekle")
Set s2 = Sheets("BARKOD")
Dim i, Adet As Long

S1.Select

Application.ScreenUpdating = False

For i = 6 To [A40].End(3).Row
   
        Set Bul = s2.Range("A5:A4000").Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            If Cells(i, "B") <> "" Then
                s2.Cells(Bul.Row, "f") = s2.Cells(Bul.Row, "f") + Cells(i, "B")
              
            Else
                
            End If
        Else
            
        End If
   

Next i

Application.ScreenUpdating = True
boshücre = Sheets("stokdurum").[a65536].End(3).Row + 1
Sheets("stokekle").Range("a6:ı38").Copy
Sheets("stokdurum").Activate
Cells(boshücre, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues



     
    Sheets("stokekle").Select
    Range("A6:A38").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-81
    
    Range("A6").Select
   
     
    For Each n In Range("B6:B38")
    If IsNumeric(n) Then
        n.Value = 1
       
    End If
    
    
Next n
   

Case vbNo
MsgBox "Vazgeçtin.", vbMsgBoxSetForeground
End Select
End Sub

 

[jambow]

pardon pardon stok durum sayfasında worksheet olayına

kod yazarak şifreledim o şifrenin sorulmamamsını istiyorum
koruma şifresi değil sayfaya girememe şifresi

Private Sub Worksheet_Activate()

ActiveWindow.WindowState = xlMinimized

sor = InputBox("Şifreyi girin. ", "Onay", "***")

If sor = 1 Then
Sheets("stokdurum").Activate
ActiveWindow.WindowState = xlMaximized
Else
Sheets("stokekle").Activate
ActiveWindow.WindowState = xlMaximized
End If

End Sub

 

[Orion1]

ilginize teşekkür ancak verdiğiniz kod işe yaramadı şifreyi kaldırmıyor

Sub urunilave2()

YesNo = MsgBox("DİKKAT!!!! Stoklarınızı Bu düğmeye Basarak eklerseniz sadece ürünleri stoklara ekler .Fatura tutarını toptancının bakiyesine işlemez.?", vbYesNo + vbCritical, "Onaylıyormusun")
Select Case YesNo
Case vbYes



Set S1 = Sheets("stokekle")
Set s2 = Sheets("BARKOD")
Dim i, Adet As Long

S1.Select

Application.ScreenUpdating = False

For i = 6 To [A40].End(3).Row
   
        Set Bul = s2.Range("A5:A4000").Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            If Cells(i, "B") <> "" Then
                s2.Cells(Bul.Row, "f") = s2.Cells(Bul.Row, "f") + Cells(i, "B")
              
            Else
                
            End If
        Else
            
        End If
   

Next i

Application.ScreenUpdating = True
boshücre = Sheets("stokdurum").[a65536].End(3).Row + 1
Sheets("stokekle").Range("a6:ı38").Copy
Sheets("stokdurum").Activate
Cells(boshücre, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues



     
    Sheets("stokekle").Select
    Range("A6:A38").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-81
    
    Range("A6").Select
   
     
    For Each n In Range("B6:B38")
    If IsNumeric(n) Then
        n.Value = 1
       
    End If
    
    
Next n
   

Case vbNo
MsgBox "Vazgeçtin.", vbMsgBoxSetForeground
End Select
End Sub

Ben yukarıda verdiğiniz kodlarda korumayı kaldıran kodları ve şifreyi göremedim.
Hangi sayfalarda kullanılacaksa o sayfaya yapmanız gerekiyor.Siz olmuyor dediğiniz kodları yazın kodları buraya yapıştırın ben bir bakayım nasıl olmuyormuş.Nedense biz yapınca oluyor bu kodlar.