VBA Kod yardımı

M

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, ekli kodda makro çalıştırırken hata alıyorum. Nerede düzenleme yapmam gerekiyor?

Teşekkür ederim.
Kod: 
Sub klasorekaydet()

If [E6] = "" Then
MsgBox "Lütfen Saat Giriniz!", vbInformation, "MSC"
Range("E6").Select
GoTo 10
Else



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..! "


'Kilitle
ActiveSheet.Unprotect Password:="3300"
ActiveSheet.Range("A4").Select
   With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .Color = 255
       .TintAndShade = 0
       .PatternTintAndShade = 0
    End With

ActiveSheet.Unprotect Password:="3300"
ActiveSheet.Range("B1:AK66").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="3300"
ActiveSheet.Range("C10").Select


'Yazdırma
Adet = Application.InputBox("Geçerli sayfadan kaç kopya çıktı almak istiyor sunuz?", "Çıktı Adedi", 1)
    If Adet = False Then Exit Sub
    If Not IsNumeric(Adet) Then GoTo 10
    If Adet > 0 Then
        Onay = MsgBox(Adet & " kopya yazdırmak istediğinize emin misiniz?", vbExclamation + vbYesNo)
        If Onay = vbYes Then
        ActiveSheet.PageSetup.PrintArea = "B3:AK65"
            ActiveSheet.PrintOut Copies:=Val(Adet), Collate:=True
            MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
        Else
            MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        End If
    Else
10    MsgBox "Hatalı çıktı adedi girişi yaptınız!" & Chr(10) & "İşleminiz iptal edilmiştir."
    End If

End If
10:

End Sub
 
E

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 tekrar dener misiniz.
Kod: 
Sub klasorekaydet()

If [E6] = "" Then
MsgBox "Lütfen Saat Giriniz!", vbInformation, "MSC"
Range("E6").Select
Exit Sub
Else



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..! "


'Kilitle
ActiveSheet.Unprotect Password:="3300"
ActiveSheet.Range("A4").Select
   With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .Color = 255
       .TintAndShade = 0
       .PatternTintAndShade = 0
    End With

ActiveSheet.Unprotect Password:="3300"
ActiveSheet.Range("B1:AK66").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="3300"
ActiveSheet.Range("C10").Select


'Yazdırma
Adet = Application.InputBox("Geçerli sayfadan kaç kopya çıktı almak istiyor sunuz?", "Çıktı Adedi", 1)
    If Adet = False Then Exit Sub
    If Not IsNumeric(Adet) Then GoTo 10
    If Adet > 0 Then
        Onay = MsgBox(Adet & " kopya yazdırmak istediğinize emin misiniz?", vbExclamation + vbYesNo)
        If Onay = vbYes Then
        ActiveSheet.PageSetup.PrintArea = "B3:AK65"
            ActiveSheet.PrintOut Copies:=Val(Adet), Collate:=True
            MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
        Else
            MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        End If
    Else
10    MsgBox "Hatalı çıktı adedi girişi yaptınız!" & Chr(10) & "İşleminiz iptal edilmiştir."
    End If

End If
End Sub
 
M

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
EmrExcel16' Alıntı:
Merhaba aşağıdaki gibi tekrar dener misiniz.
Kod: 
Sub klasorekaydet()

If [E6] = "" Then
MsgBox "Lütfen Saat Giriniz!", vbInformation, "MSC"
Range("E6").Select
Exit Sub
Else



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..! "


'Kilitle
ActiveSheet.Unprotect Password:="3300"
ActiveSheet.Range("A4").Select
   With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .Color = 255
       .TintAndShade = 0
       .PatternTintAndShade = 0
    End With

ActiveSheet.Unprotect Password:="3300"
ActiveSheet.Range("B1:AK66").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect Password:="3300"
ActiveSheet.Range("C10").Select


'Yazdırma
Adet = Application.InputBox("Geçerli sayfadan kaç kopya çıktı almak istiyor sunuz?", "Çıktı Adedi", 1)
    If Adet = False Then Exit Sub
    If Not IsNumeric(Adet) Then GoTo 10
    If Adet > 0 Then
        Onay = MsgBox(Adet & " kopya yazdırmak istediğinize emin misiniz?", vbExclamation + vbYesNo)
        If Onay = vbYes Then
        ActiveSheet.PageSetup.PrintArea = "B3:AK65"
            ActiveSheet.PrintOut Copies:=Val(Adet), Collate:=True
            MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
        Else
            MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        End If
    Else
10    MsgBox "Hatalı çıktı adedi girişi yaptınız!" & Chr(10) & "İşleminiz iptal edilmiştir."
    End If

End If
End Sub
Genişletmek için tıkla ...
Merhaba,

400 Hatası verdi hocam
 
E

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Tam olarak nerede (hangi satırda) hata veriyor ,Debug yapıp bildirebilirmisiniz .
 
E

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Kodları boş bir dosyaya ekledim çalıştırdım bende hata vermedi.
 
M

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
EmrExcel16' Alıntı:
Kodları boş bir dosyaya ekledim çalıştırdım bende hata vermedi.
Genişletmek için tıkla ...
Merhaba Hocam, modülde denedim sorunsuz çalıştı.

E6 Hücresine saat yazılması için sorgulatmak istedim. Ancak, makroyu çalıştırırken E6 hücresine o anki saati otomatik yazdırma imkanı var mı acaba?

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

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 , E6 hücresine her makroyu çalıştırdığınızda anlık o saatin yazmasını mı istiyorsunuz.
 
E

EmrExcel16

Destek Ekibi
Destek Ekibi
Katılım
1 Kasım 2012
Mesajlar
1,524
Excel Vers. ve Dili
Office 365 Türkçe
Aşağıdaki gibi deneyin.
Kod: 
Sub klasorekaydet()

    'If [E6] = "" Then
        [E6] = Format(Now(), "hh:mm")
        'MsgBox "Lütfen Saat Giriniz!", vbInformation, "MSC"
        'Range("E6").Select
        'Exit Sub
    'End If
    
    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..! "
    
    
    'Kilitle
    ActiveSheet.Unprotect Password:="3300"
    ActiveSheet.Range("A4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
     End With

    ActiveSheet.Unprotect Password:="3300"
    ActiveSheet.Range("B1:AK66").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect Password:="3300"
    ActiveSheet.Range("C10").Select

    'Yazdırma
    Adet = Application.InputBox("Geçerli sayfadan kaç kopya çıktı almak istiyor sunuz?", "Çıktı Adedi", 1)
    If Adet = False Then Exit Sub
    If Not IsNumeric(Adet) Then GoTo 10
    If Adet > 0 Then
        Onay = MsgBox(Adet & " kopya yazdırmak istediğinize emin misiniz?", vbExclamation + vbYesNo)
        If Onay = vbYes Then
        ActiveSheet.PageSetup.PrintArea = "B3:AK65"
            ActiveSheet.PrintOut Copies:=Val(Adet), Collate:=True
            MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
        Else
            MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        End If
    Else
10    MsgBox "Hatalı çıktı adedi girişi yaptınız!" & Chr(10) & "İşleminiz iptal edilmiştir."
    End If

End Sub
 
M

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
EmrExcel16' Alıntı:
Aşağıdaki gibi deneyin.
Kod: 
Sub klasorekaydet()

    'If [E6] = "" Then
        [E6] = Format(Now(), "hh:mm")
        'MsgBox "Lütfen Saat Giriniz!", vbInformation, "MSC"
        'Range("E6").Select
        'Exit Sub
    'End If
   
    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..! "
   
   
    'Kilitle
    ActiveSheet.Unprotect Password:="3300"
    ActiveSheet.Range("A4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 255
        .TintAndShade = 0
        .PatternTintAndShade = 0
     End With

    ActiveSheet.Unprotect Password:="3300"
    ActiveSheet.Range("B1:AK66").Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect Password:="3300"
    ActiveSheet.Range("C10").Select

    'Yazdırma
    Adet = Application.InputBox("Geçerli sayfadan kaç kopya çıktı almak istiyor sunuz?", "Çıktı Adedi", 1)
    If Adet = False Then Exit Sub
    If Not IsNumeric(Adet) Then GoTo 10
    If Adet > 0 Then
        Onay = MsgBox(Adet & " kopya yazdırmak istediğinize emin misiniz?", vbExclamation + vbYesNo)
        If Onay = vbYes Then
        ActiveSheet.PageSetup.PrintArea = "B3:AK65"
            ActiveSheet.PrintOut Copies:=Val(Adet), Collate:=True
            MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
        Else
            MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        End If
    Else
10    MsgBox "Hatalı çıktı adedi girişi yaptınız!" & Chr(10) & "İşleminiz iptal edilmiştir."
    End If

End Sub
Genişletmek için tıkla ...
Teşekkür ederim hocam, tam istediğim gibi oldu.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst