Yazdırma alanını hücreden belirtme

[Mehmet Sait]

Merhaba,

Yazdırma alanı olarak belirtilen bu kısmı " ActiveSheet.Range("$B$2:$R$29") " sayfadaki hücreden aldırmak mümkün mü ?

ActiveSheet.Range("$B$2:$R$29").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        masaustuyolu & "\" & dosyaadi & ".pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

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

 

[ÖmerFaruk]

Sayfadaki hücrede ne yazıyor?

 

[Mehmet Sait]

Sayfadaki hücrede ne yazıyor?

Haftalık değiştiği için kod kısmına girmeden hücreye bunu yazmak istiyorum. " $B$2:$R$29 "

 

[ÖmerFaruk]

Denemeden yazıyorum.Yazdırma alanını A1 hücresine yazdıysanız aşağıdaki gibi deneyin.
A1=$B$2:$R$9

ActiveSheet.Range(Range("A1"))...............

Haftalık değişen yazdırma alanı eğer belli bir kural oluşabiliyorsa kodlarla otomatik de yapılabilir.

 

[Mehmet Sait]

Denemeden yazıyorum.Yazdırma alanını A1 hücresine yazdıysanız aşağıdaki gibi deneyin.
A1=$B$2:$R$9

ActiveSheet.Range(Range("A1"))...............

Haftalık değişen yazdırma alanı eğer belli bir kural oluşabiliyorsa kodlarla otomatik de yapılabilir.

Denedim olmadı. Kural şu şekilde; ilgili ayın haftalarını yazdırıyorum. Ayın ilk haftası ile içinde bulunduğumuz haftayı şeçebilmeli.

 

[ÖmerFaruk]

Olmayan neresi onu anlamak lazım önce
Kodlarınzda masaustuyolu bir değişken mi sabit mi değer nedir bilemiyorum.
Denemeden yazıyorum sürekli.
Eğer kodlarınız o haliyle çalışıyorsa dediğim gibi de çalışması gerek diye düşnüüyorum

Altın üyesiniz. Örnek bir dosya atarsanız daha kolay cevap gelecektir.

 

[Mehmet Sait]

Olmayan neresi onu anlamak lazım önce
Kodlarınzda masaustuyolu bir değişken mi sabit mi değer nedir bilemiyorum.
Denemeden yazıyorum sürekli.
Eğer kodlarınız o haliyle çalışıyorsa dediğim gibi de çalışması gerek diye düşnüüyorum

Altın üyesiniz. Örnek bir dosya atarsanız daha kolay cevap gelecektir.

Hocam, Hücrede olanı yazdırdı. "$B$2:$R$9 "

Örnek; Mart ayı 9 ile 14. haftalarda. Her yazdırıldığında 9 ile içinde bulunduğumuz haftayı baz alacak şekilde.

Kullanılan kod;

Sub haftalıkhat()
' ---------------------
' Pdf Oluştur ve Kaydet
' ---------------------



Sheets("Haftalık Hat").Select

Set nesne = CreateObject("Scripting.FileSystemObject")
masaustuyolu = CreateObject("Wscript.Shell").SpecialFolders("Desktop")
'AyAdi = Format(Date, "mmmm")
'klasoradi = Format(Date, "dd.mm.yyyy") & " "
dosyaadi = "5 - " & [B2]
klasorara = nesne.FolderExists(masaustuyolu & "\" & AyAdi)
If klasorara = False Then nesne.CreateFolder masaustuyolu & "\" & AyAdi

'With
ActiveSheet.PageSetup.PaperSize = 281
'End With


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

    ActiveSheet.Range("B2").Select

    ActiveWindow.Zoom = 100
    ActiveSheet.Protect Password:="3"
End Sub

 

[Saban Sertkaya]

Ömer Hocam'a saygılarla,
Altın üye olmadığımdan dosyanızı görme şansım yok. Sadece sorduğunuz soruya istinaden ChatGPT 3,5 ile alınan bir cevap yazmak istedim.

Eğer aralığı elle girmek istiyorsanız, kodu direkt olarak belirli bir hücredeki metni alacak şekilde düzenleyebiliriz. İşte kodunuzun bu şekilde güncellenmiş hali: (A1 hücresine yazılan aralığa göre çalışacaktır. B2:R29 yazmak yeterli olacaktır.)

vba
Copy code
Dim rng As Range
Dim aralikMetni As String

' A1 hücresinden aralık metnini al
aralikMetni = Range("A1").Value

' Belirtilen aralığı belirleyin
On Error Resume Next
Set rng = ActiveSheet.Range(aralikMetni)
On Error GoTo 0

' Geçersiz aralık metni girilirse veya aralık bulunamazsa
If rng Is Nothing Then
    MsgBox "Geçersiz aralık metni girdiniz veya aralık bulunamadı.", vbExclamation
    Exit Sub
End If

' PDF olarak kaydetme işlemi
rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        masaustuyolu & "\" & "dosyaadi.pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

 

[Mehmet Sait]

Ömer Hocam'a saygılarla,
Altın üye olmadığımdan dosyanızı görme şansım yok. Sadece sorduğunuz soruya istinaden ChatGPT 3,5 ile alınan bir cevap yazmak istedim.

Eğer aralığı elle girmek istiyorsanız, kodu direkt olarak belirli bir hücredeki metni alacak şekilde düzenleyebiliriz. İşte kodunuzun bu şekilde güncellenmiş hali: (A1 hücresine yazılan aralığa göre çalışacaktır. B2:R29 yazmak yeterli olacaktır.)

vba
Copy code
Dim rng As Range
Dim aralikMetni As String

' A1 hücresinden aralık metnini al
aralikMetni = Range("A1").Value

' Belirtilen aralığı belirleyin
On Error Resume Next
Set rng = ActiveSheet.Range(aralikMetni)
On Error GoTo 0

' Geçersiz aralık metni girilirse veya aralık bulunamazsa
If rng Is Nothing Then
    MsgBox "Geçersiz aralık metni girdiniz veya aralık bulunamadı.", vbExclamation
    Exit Sub
End If

' PDF olarak kaydetme işlemi
rng.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        masaustuyolu & "\" & "dosyaadi.pdf" _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False

Teşekkür ederim. Çalıştı.

 

[Saban Sertkaya]

ChatGPT'ye rica ederiz. Sanırım mesleği elimizden alıyor. DEVIN ise AI'nin şu an ki nirvanası gibi görünüyor.