Hücre Değerine Göre Farklı Makro Çalışsın

[Yuisfaz]

Merhabalar..
Çalıştığım bir sayfada bir noktada takıldım. Açılan listedeki seçime göre farklı alanları yazdırma alanı olarak belirleyebilir miyim? Örneğin A1 hücresinde "Ahmet" varsa, A10:C20 alanını, "Ayşe" varsa D1:J20 alanını yazdırma alanı olarak nasıl belirleyebilirim? Bu alanlar için yazdırma alanı belirle kodunu makro halinde yazdım ama seçime göre çalıştırma kodunu forumda bulamadım. Bulduklarımı da kendi kitabıma uyduramadım. Yardımcı olur musunuz?

 

[Mahir64]

Merhabalar..
Çalıştığım bir sayfada bir noktada takıldım. Açılan listedeki seçime göre farklı alanları yazdırma alanı olarak belirleyebilir miyim? Örneğin A1 hücresinde "Ahmet" varsa, A10:C20 alanını, "Ayşe" varsa D1:J20 alanını yazdırma alanı olarak nasıl belirleyebilirim? Bu alanlar için yazdırma alanı belirle kodunu makro halinde yazdım ama seçime göre çalıştırma kodunu forumda bulamadım. Bulduklarımı da kendi kitabıma uyduramadım. Yardımcı olur musunuz?

Bir modüle kopyalayın

Sub Yazdırma_alanı()
If Range("a1") = "Ahmet" Then
ActiveSheet.PageSetup.PrintArea = "$A$10:$c$10"
Else
ActiveSheet.PageSetup.PrintArea = "$d$1:$J$20"
End If
End Sub

 

[Mahir64]

Merhaba
Bu işlemi daha kolay yolldan yapabilirsiniz
CTRL basılı ikin istediğiniz alanları seçin ve dosya yazdırma alanı belirle diyerek belirleyin,
ilk seçtiğiniz alan 1. yazdırma alanı, İkinci seçtiğiniz alan 2 yazdırma alaını olur (Ad Tanımlamada görebilirsiniz)
Sonra iki buton ekleyin ahmet - ayşe aşağıda ki kodları butonlar ekleyin ayşe 2.ise kırmızı ile iki görünüyor Makro2

Sub Makro1()
    ActiveWindow.SelectedSheets.PrintOut [COLOR=Red]From:=1, To:=1,[/COLOR] Copies:=1, Collate _
        :=True
End Sub
Sub Makro2()
    ActiveWindow.SelectedSheets.PrintOut [COLOR=Red]From:=2, To:=2[/COLOR], Copies:=1, Collate _
        :=True
End Sub

 

[Yuisfaz]

Merhaba
Bu işlemi daha kolay yolldan yapabilirsiniz
CTRL basılı ikin istediğiniz alanları seçin ve dosya yazdırma alanı belirle diyerek belirleyin,
ilk seçtiğiniz alan 1. yazdırma alanı, İkinci seçtiğiniz alan 2 yazdırma alaını olur (Ad Tanımlamada görebilirsiniz)
Sonra iki buton ekleyin ahmet - ayşe aşağıda ki kodları butonlar ekleyin ayşe 2.ise kırmızı ile iki görünüyor Makro2

Sub Makro1()
    ActiveWindow.SelectedSheets.PrintOut [COLOR=Red]From:=1, To:=1,[/COLOR] Copies:=1, Collate _
        :=True
End Sub
Sub Makro2()
    ActiveWindow.SelectedSheets.PrintOut [COLOR=Red]From:=2, To:=2[/COLOR], Copies:=1, Collate _
        :=True
End Sub

Bu geç vakitte gösterdiğiniz ilginiz için teşekkür ederim. Acaba hiç buton kullanmadan, veri doğrulamanın açılan listesindeki değer değiştiğinde bu makroyu nasıl çalıştırabilirim. Yani veri doğrulamada "Ayşe"yi seçtiğimde Ayşe'nin alanı yazdırma alanı olabilir mi?

 

[Mahir64]

Bu geç vakitte gösterdiğiniz ilginiz için teşekkür ederim. Acaba hiç buton kullanmadan, veri doğrulamanın açılan listesindeki değer değiştiğinde bu makroyu nasıl çalıştırabilirim. Yani veri doğrulamada "Ayşe"yi seçtiğimde Ayşe'nin alanı yazdırma alanı olabilir mi?

MErhaba
Çalışma sayfasının kod bölümüne

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("a1") = "Ahmet" Then
ActiveSheet.PageSetup.PrintArea = "$A$10:$c$10"
Else
ActiveSheet.PageSetup.PrintArea = "$d$1:$J$20"
End If
End Sub

 

[Yuisfaz]

MErhaba
Çalışma sayfasının kod bölümüne

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("a1") = "Ahmet" Then
ActiveSheet.PageSetup.PrintArea = "$A$10:$c$10"
Else
ActiveSheet.PageSetup.PrintArea = "$d$1:$J$20"
End If
End Sub

Çok Teşekkür ederim.

 

[Mahir64]

Çok Teşekkür ederim.

Rica ederim
Kolay gelsin

 

[unur]

Aşağıdaki kodu eğer a1 de Ahmet yazıyorsa yazdıracak alan yok diye mesaj verse, yoksa else den sonraki yazdırma işlemini gerçekleştirmesi için nasıl bir revizyon yapmamız lazım kodlarda

Teşekkürler.

MErhaba
Çalışma sayfasının kod bölümüne

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("a1") = "Ahmet" Then
ActiveSheet.PageSetup.PrintArea = "$A$10:$c$10"
Else
ActiveSheet.PageSetup.PrintArea = "$d$1:$J$20"
End If
End Sub

 

[unur]

Güncellemek için

 

[Mahir64]

Merhaba,

Sub yazdır()
If Range("a1") = "Ahmet" Then
MsgBox "Yazdırma Alanı Yok"
Else
ActiveSheet.PrintOut
End If
End Sub

 

[unur]

Mahir bey çok Teşekkürler.Allah Razı olsun.

 

[Orion1]

Parametrik prosedürler konusunu araştırmanızı öneririm.

 

[Resspect]

Merhaba Arkadaşlar.

Bir konuda yardıma ihtiyaçım var; a1 hücresine tanımladığım makro değeri manuel girince çalışıyor fakat formül olduğunda içinde veri değiştiğinde çalışmıyor.nasıl yapabilirim bu konuda yardımlarınız rica ederim.