VBA : PRTSC

[Supachok]

เรียน ท่านอาจารย์

1.ต้องการ PRTSC
2.save to Clipboard.
3.Paste active sheet.
3.1 หรือ paste ลง body mail.

พยายามปรับหลายสูตรไม่สามารถสำเร็จได้
สูตรล่าสุด VBA paste ตั้งแต่ DIM ที่ประกาศตัวแปร ทำอย่างไร VBA จะรู้ว่าต้องการ Paste ข้อมูลจาก PRTSC
ปล. Mydata ไม่สามารถใช้ MSfrom ได้ run VBA แล้วฟ้อง



Dim MyData As Object
Set MyData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Application.SendKeys "{PRTSC}"
MyData.GetFromClipboard
Range("b1").Select
ActiveSheet.Paste



[snasui]

กรุณา Post Code VBA ด้วยการครอบด้วย Tag Code ดูวิธีการในกฎการใช้บอร์ดข้อ 5 ด้านบนครับ

[Supachok]

กรุณา Post Code VBA ด้วยการครอบด้วย Tag Code ดูวิธีการในกฎการใช้บอร์ดข้อ 5 ด้านบนครับ


Sub Macro4()

Dim MyData As Object
Set MyData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Application.SendKeys "{PRTSC}"
MyData.GetFromClipboard
Range("b1").Select
ActiveSheet.Paste

End Sub


ไม่ค่อยเข้าใจว่าผมทำไม่ถูกตรงไหน แต่ลองใส่ Code มาใหม่แล้วครับ

[snasui]

ยังไม่ถูกครับ

กรุณาคลิก Link ที่ท้ายข้อ 5 เพื่อดูวิธีการที่ถูกต้องครับ

TagCode.jpg

ที่ทำมาเป็นแบบ Inline ซึ่งไม่ถูกต้องครับ

InlineCode.jpg

[Supachok]

เรียน ท่านอาจารย์

ออ ต้องเติมอักษรให้เต็ม จากตัวย่อจึงจะแสดง Select all

Code: Select all

Sub Macro4()

Dim MyData As Object
Set MyData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
Application.SendKeys "{PRTSC}"
MyData.GetFromClipboard
Range("b1").Select
ActiveSheet.Paste
End Sub

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Option Explicit

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

Private Const VK_SNAPSHOT = &H2C

Sub PrintScreen()
    Call Macro4
    keybd_event VK_SNAPSHOT, 1, 0, 0
    Range("b1").Select
    ActiveSheet.Paste
End Sub


Sub Macro4()
    '
    ' Macro4 Macro
    Dim MyData As Object
    Set MyData = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Dim path As String
    path = "C:\Users\<user>\AppData\Local\Microsoft\Teams\current\Teams.exe" ' Replace <username> with your actual username
    Shell path, vbNormalFocus
'    Application.SendKeys "{PRTSC}"
'    MyData.GetFromClipboard
'    Range("b1").Select
    'ActiveSheet.Paste
'    Application.SendKeys "^v"
End Sub