Userform Ekran Görüntüsü Alma,

[TiOr]

Merhaba,
Userform ekranımdan sık sık ekran görüntüsü alarak maile ekliyor ve iletiyorum.
Userform üzerine copi al butonu ile userform ekranının ekran görüntüsünü alabilmemiz mümkün müdür?
Kod kısmında kıymetli desteklerinizi talep ederim.
Ekte örnek dosya mevcuttur.

 

[YUSUF44]

Şöyle bir konu buldum:

Take a snapshot of a userform

Hi, I have a userform with text boxes, combo, boxes,etc and I want to take a snapshot of it so I can paste it in either outlook or lotus notes email. Basically, this should be like a printscreen function but should only get the image of the userform. How do i do this in VBA, if possible? I...

www.mrexcel.com

 

[TiOr]

@YUSUF44 Hocam Merhaba,
Dönüşün ve ilgin için teşekkür ederim.
Bu konuyu okudum ve uyguladım bu konuda ki paylaşılan kod ekran görüntüsünü alıyor ve outlooku açarak ekliyor.
Burada ben outlooka yapıştırmasını ve outlooku açmasını istemiyorum.

Şöyle izah edeyim bana gelen maillere tümünü yanıtla diyerek cevap veriyorum ve ekran alıntısı aracı ile ekran görüntüsü alarak kendim ekliyorum. Fakat bahsi geçen uygulamada ayrıca bir mail oluşturuyor. Diğer sayfalardaki kodlarda ayrıca çalışmıyor hata veriyor.

Outlooku ve maili unutalım. Userformun ekran görüntüsünü alabilmemizin oluru var mıdır?
Var ise yardımlarınızı talep ederim.

 

[YUSUF44]

Ordan anladığım Alt+PrintScreen tuş kombinasyonunun ekrandaki userformun görüntüsünü almayı sağlıyor ve orda da o işlemin kod hali paylaşılmış. Ancak ben o kodları nedense uygulayamadım. Declare kodlarını modüle ekleyip, command buttona diğer kodları ekleyince keybdevent kodunu bulamadığına dair hata veriyor. Declare kodlarını userforma ekleyince ise hiç çalışmıyor.

Ancak bu sitede bulduğum çözümü uygulayabildim. Tabi bazı kodlarda değişiklik yaptım ve userform görüntüsünü aynı sayfaya yapıştırabildim. Yapıştırma kısmını siz nasıl olsa istediğiniz gibi düzenleyebilirsiniz.

Bunun için dosyaya bir modül ekleyin ve aşağıdaki kodları modüle yapıştırın:

Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

'Public Const VK_SNAPSHOT = &H2C

Public Const VK_SNAPSHOT = 44
Public Const VK_LMENU = 164
Public Const KEYEVENTF_KEYUP = 2
Public Const KEYEVENTF_EXTENDEDKEY = 1

Burdaki ptrsafe ifadesini 64 bit kullandığım için ben ekledim, eklemezsem hata veriyor.

Userformdaki commandbutton kodlarını da aşağıdakiyle değiştirin:

Private Sub CommandButton1_Click()
' keybd_event VK_SNAPSHOT, 0, 0, 0
DoEvents
keybd_event VK_LMENU, 0, _
KEYEVENTF_EXTENDEDKEY, 0 ' key down
keybd_event VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY, 0
keybd_event VK_SNAPSHOT, 0, _
KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
keybd_event VK_LMENU, 0, _
KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
DoEvents
'Workbooks.Add
'Application.Wait Now + TimeValue("00:00:01")
'ActiveSheet.PasteSpecial Format:="Bitmap", _
'Link:=False, DisplayAsIcon:=False
ActiveSheet.Range("A1").Select
ActiveSheet.Paste
'ActiveWindow.SelectedSheets.PrintOut Copies:=1
'ActiveWorkbook.Close False
End Sub

Kendinize göre güncellersiniz inşallah.

 

[TiOr]

@YUSUF44 Hocam Selam,
İşlem tamam, desteğin için çok teşekkür ederim.
Bilgi amaçlı paylaşıyorum;

ActiveSheet.Range("A1").Select
ActiveSheet.Paste

Bu kısmı sildim. Butona tıkladığımda formun kopyasını alıyor ve sonrasında istediğin yere yapıştır.

Tekrardan teşekkür eder, hayırlı akşamlar dilerim.

 

[assenucler]

Sn. TiOr,

Merhabalar, rica etsem dosyanızın son şeklini eklemeniz mümkün mü?
İlgi ve yardımınız için önceden teşekkürler.

Saygılar,
Selim

 

[TiOr]

Sn. TiOr,

Merhabalar, rica etsem dosyanızın son şeklini eklemeniz mümkün mü?
İlgi ve yardımınız için önceden teşekkürler.

Saygılar,
Selim

Merhaba, Sn. @assenucler ;
Ekte örnek dosyamı paylaşıyorum.
CommandButton1 tıkladığınızda karşınıza gelecek olan userformda copi al butonuna tıklıyoruz. Userformun ekran görüntüsünü almaktadır. Akabinde userformdan çıkarak ctrl+v yaptığınızda excele ekran görüntüsünü yapıştırdığını göreceksiniz. Aynı şekilde mail gövdesine de yapıştırma işlemini rahatlıkla yapabilmekteyiz.
Bu vesile ile tekrardan @YUSUF44 hocama desteği için teşekkür ederim.
Çok basit ve saçma gibi görülen bazı uygulamalar ciddi bir zaman tasarrufu sağlamaktadır.
İyi günlerde kullanmanız temennisi ile, hayırlı günler ve şimdiden hayırlı bayramlar dilerim.

 

[Korhan Ayhan]

Bu durumda aşağıdaki kodlarda işe yarayacaktır.

Option Explicit

Private Sub CommandButton1_Click()
    Application.SendKeys "(%{1068})"
    DoEvents
    Unload Me
End Sub

 

[TiOr]

@Korhan Ayhan Hocam Selam,
Bilgi için teşekkür ederim. Kod arşivime aldım
Şimdiden hayırlı bayramlar, sağlıcakla kalın.

 

[assenucler]

@TiOr


Paylaşımınız ve emeği geçen üstatlara teşekkür ederim. Allah razı olsun.

Ben de bugünden Ramazan Bayramınızı kutlar, sağlık ve afiyetler ile bol rızıklar dilerim.

Saygılar,
Selim

 

[assenucler]

@sayın Korhan Ayhan,

Yukarıda 8. iletiye eklediğiniz kodu hangi durumda kullanabilirim?
Selam ve sevgiler.

Saygılar,
Selim

 

[TiOr]

Merhaba Selim Bey, @assenucler
@Korhan Ayhan hocama yardımcı olmak maiyetinde revize dosyayı ekledim.
Userformun kod kısmındaki kodu silip Ayhan hocamın paylaşmış olduğu kodu ekleyebilirsiniz.
Buradaki fark anladığım kadarıyla copi al dediğimizde userformu kapatıyor. Userform kapanınca excele bir kere tıklamanız gerekli yapıştırmak için tabi bu excel için geçerli. Farklı platformda da yapıştırma işlemini gerçekleştiriyor hiç bir problem yok.
Bildiğim kadarıyla paylaştım.
Hayırlı akşamlar...

 

[Korhan Ayhan]

Yusuf beyin paylaşımında api kullanılmış. Benim önerimde api yok. Tek fark budur.