Şifre ile Makro Çalıştırma

[Mehmet Sait]

Merhaba,

Makroyu çalıştırırken eğer şifre doğru ise makro çalışsın değilse çalışmasın. Bulduğum ekli kodu deniyorum ama şifre yanlış girsem bile makroya devam ediyor. Yanlış şifre girildiğinde durması için ne gibi değişim yapmam gerek ?

Yardımlarınız için teşekkür ederim.

 Şifreleme için kullandığım kod:
Sub N()
ŞİFRE = "12345"
cvp = InputBox("ŞİFRE GİRİNİZ", "FEDEAL")
If cvp = ŞİFRE Then
'KODLARI BURAYA YAZBİLİRSİNİZ.
MsgBox "MAKROLAR ÇALIŞTI"
Else
MsgBox "ŞİFRE YANLIŞ"
End If
End Sub

Butona atadığım kod:
Sub klasorekaydet()
Call N
Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
'AyAdi = Format(Date, "mmmm")
'klasoradi = Format(Date, "dd.mm.yyyy") & " "
dosyaadi = Format(Date, "dd.mm.yyyy") & " Stok Sayım Raporu"
klasorara = nesne.FolderExists(masaustuyolu & "\" & AyAdi)
If klasorara = False Then nesne.CreateFolder masaustuyolu & "\" & AyAdi

ActiveSheet.Range("$B$3:$AK$65").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        masaustuyolu & "\" & dosyaadi & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
       
MsgBox "  PDF olarak kaydedildi..! "



    End Sub

 

[EmrExcel16]

Merhaba aşağıdaki gibi deneyiniz.

Sub klasorekaydet()
ŞİFRE = "12345"
cvp = InputBox("ŞİFRE GİRİNİZ", "FEDEAL")
If cvp = ŞİFRE Then
    Set nesne = CreateObject("Scripting.FileSystemObject")
    masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
    'AyAdi = Format(Date, "mmmm")
    'klasoradi = Format(Date, "dd.mm.yyyy") & " "
    dosyaadi = Format(Date, "dd.mm.yyyy") & " Stok Sayım Raporu"
    klasorara = nesne.FolderExists(masaustuyolu & "\" & AyAdi)
    If klasorara = False Then nesne.CreateFolder masaustuyolu & "\" & AyAdi
    
    ActiveSheet.Range("$B$3:$AK$65").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            masaustuyolu & "\" & dosyaadi & ".pdf" _
            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
          
    MsgBox "  PDF olarak kaydedildi..! "
    MsgBox "MAKROLAR ÇALIŞTI"
Else
MsgBox "ŞİFRE YANLIŞ"
End If
End Sub

 

[YUSUF44]

Makro ayrı, buton ayrı kod yerine butonda aşağıdaki kodu deneyin:

Sub N()
    ŞİFRE = "12345"
    cvp = InputBox("ŞİFRE GİRİNİZ", "FEDEAL")
    If cvp = ŞİFRE Then
        Set nesne = CreateObject("Scripting.FileSystemObject")
        masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
        'AyAdi = Format(Date, "mmmm")
        'klasoradi = Format(Date, "dd.mm.yyyy") & " "
        dosyaadi = Format(Date, "dd.mm.yyyy") & " Stok Sayım Raporu"
        klasorara = nesne.FolderExists(masaustuyolu & "\" & AyAdi)
        If klasorara = False Then nesne.CreateFolder masaustuyolu & "\" & AyAdi
        
        ActiveSheet.Range("$B$3:$AK$65").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                masaustuyolu & "\" & dosyaadi & ".pdf" _
                , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                :=False, OpenAfterPublish:=False
              
        MsgBox "  PDF olarak kaydedildi..! "
    Else
        MsgBox "ŞİFRE YANLIŞ"
    End If
End Sub

 

[Mehmet Sait]

Merhaba aşağıdaki gibi deneyiniz.

Sub klasorekaydet()
ŞİFRE = "12345"
cvp = InputBox("ŞİFRE GİRİNİZ", "FEDEAL")
If cvp = ŞİFRE Then
    Set nesne = CreateObject("Scripting.FileSystemObject")
    masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
    'AyAdi = Format(Date, "mmmm")
    'klasoradi = Format(Date, "dd.mm.yyyy") & " "
    dosyaadi = Format(Date, "dd.mm.yyyy") & " Stok Sayım Raporu"
    klasorara = nesne.FolderExists(masaustuyolu & "\" & AyAdi)
    If klasorara = False Then nesne.CreateFolder masaustuyolu & "\" & AyAdi
   
    ActiveSheet.Range("$B$3:$AK$65").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            masaustuyolu & "\" & dosyaadi & ".pdf" _
            , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
            :=False, OpenAfterPublish:=False
         
    MsgBox "  PDF olarak kaydedildi..! "
    MsgBox "MAKROLAR ÇALIŞTI"
Else
MsgBox "ŞİFRE YANLIŞ"
End If
End Sub

Teşekkür ederim

 

[Mehmet Sait]

Makro ayrı, buton ayrı kod yerine butonda aşağıdaki kodu deneyin:

Sub N()
    ŞİFRE = "12345"
    cvp = InputBox("ŞİFRE GİRİNİZ", "FEDEAL")
    If cvp = ŞİFRE Then
        Set nesne = CreateObject("Scripting.FileSystemObject")
        masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
        'AyAdi = Format(Date, "mmmm")
        'klasoradi = Format(Date, "dd.mm.yyyy") & " "
        dosyaadi = Format(Date, "dd.mm.yyyy") & " Stok Sayım Raporu"
        klasorara = nesne.FolderExists(masaustuyolu & "\" & AyAdi)
        If klasorara = False Then nesne.CreateFolder masaustuyolu & "\" & AyAdi
       
        ActiveSheet.Range("$B$3:$AK$65").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                masaustuyolu & "\" & dosyaadi & ".pdf" _
                , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
                :=False, OpenAfterPublish:=False
             
        MsgBox "  PDF olarak kaydedildi..! "
    Else
        MsgBox "ŞİFRE YANLIŞ"
    End If
End Sub

Teşekkür Ederim

 

[EmrExcel16]

Teşekkür ederim

Rica ederim , iyi çalışmalar.