Şifre ile Makro Çalıştırma

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
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.

Kod:
 Ş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
Kod:
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

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba aşağıdaki gibi deneyiniz.
Kod:
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

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Makro ayrı, buton ayrı kod yerine butonda aşağıdaki kodu deneyin:

PHP:
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

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Merhaba aşağıdaki gibi deneyiniz.
Kod:
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

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
834
Excel Vers. ve Dili
Office 2016 TR
Altın Üyelik Bitiş Tarihi
08-09-2028
Makro ayrı, buton ayrı kod yerine butonda aşağıdaki kodu deneyin:

PHP:
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
 
Üst