Çözüldü Whatsappweb Tabloyu Resim Olarak Göndermek

[scienceman01]

Merhaba dostlar. excel sayfamdaki bi tabloyu kopyalayıp whatsapweb de bir kişiye resim olarak göndermek istiyorum. aşağıdaki kod çalışıyor lakin yapıştırma işini metin olarak yapıyor direk ctrl+v yapmıyor. yardımcı olursanız sevinirim.

Private Sub CommandButton1_Click()
Dim kime As String
Dim tablo As String
Dim x As Long
ActiveSheet.Range("C10").Value = ""
For x = 2 To 10000
    If ActiveSheet.Range("A" & x).Value = "" Then Exit For
    Next
    kime = ActiveSheet.Range("B10").Value
  
    tablo = ActiveSheet.Range("A1:AX5").Copy
ActiveWorkbook.FollowHyperlink Address:="WhatsApp Web"
Application.Wait (Now + TimeValue("00:00:15"))
Call SendKeys("{TAB}", True)
Call SendKeys("{TAB}", True)
Call SendKeys("{TAB}", True)
Call SendKeys("{TAB}", True)
Call SendKeys("{TAB}", True)
Call SendKeys(kime, True)
Call SendKeys("~", True)
Application.Wait (Now + TimeValue("00:00:3"))
Call SendKeys(tablo, True)
Call SendKeys(ActiveSheet.Paste, True)
Call SendKeys("~", True)
Application.Wait (Now + TimeValue("00:00:2"))
ActiveSheet.Range("C10").Value = "GÖNDERİLDİ"
End Sub

 

[azraep]

bu konuyu incelerseniz işinize yarayabilir.

UserForm'dan Whatsapp'a Veri Gönderme

Merhaba üstadlarım, aşağıdaki kod ile excel RD sayfasındaki belirlediğim aralığı resim olarak kopyalayıp aynı sayfada j1 hücresine yapıştırıp oradan da whatsapp uygulaması üzerinden ilgili numaraya gönderme işlemini yaptırıyordum ve gönderimi yaptımıda resmi J1 den sildiriyorum ama son...

excelcozum.com

 

[scienceman01]

bu konuyu incelerseniz işinize yarayabilir.

UserForm'dan Whatsapp'a Veri Gönderme

Merhaba üstadlarım, aşağıdaki kod ile excel RD sayfasındaki belirlediğim aralığı resim olarak kopyalayıp aynı sayfada j1 hücresine yapıştırıp oradan da whatsapp uygulaması üzerinden ilgili numaraya gönderme işlemini yaptırıyordum ve gönderimi yaptımıda resmi J1 den sildiriyorum ama son...

excelcozum.com

sadece yapıştır komutu lazım bana, ilgili konuda bulamadım istediğimi yinede teşekkür ederim

 

[Patron]

Deneyiniz.

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    ActiveSheet.Range("C10").Value = ""
    For x = 2 To 10000
        If ActiveSheet.Range("A" & x).Value = "" Then Exit For
    Next
    ActiveSheet.Range("A1:AX" & x).CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Application.Wait (Now + TimeValue("00:00:02"))
    Range("A1").Select
    ActiveSheet.Paste
    Selection.ShapeRange.Name = "Picture 1"
    ActiveSheet.Shapes("Picture 1").Copy
    Application.Wait (Now + TimeValue("00:00:02"))
    ActiveWorkbook.FollowHyperlink Address:="https://web.whatsapp.com/send/?phone=" & ActiveSheet.Range("B10").Value
    Application.Wait (Now + TimeValue("00:00:20"))
    Call SendKeys("^v")
    Application.Wait (Now + TimeValue("00:00:05"))
    Call SendKeys("~", True)
    Application.SendKeys "{NUMLOCK}%s"
    Application.Wait (Now + TimeValue("00:00:02"))
    Call SendKeys("^+W")
    Application.Wait (Now + TimeValue("00:00:02"))
    Call SendKeys("~", True)
    Application.Wait (Now + TimeValue("00:00:02"))
    ActiveSheet.Shapes("Picture 1").Delete
    Application.ScreenUpdating = True
    Application.CutCopyMode = True
    ActiveSheet.Range("C10").Value = "GÖNDERİLDİ"
    MsgBox "GÖNDERİLDİ", vbInformation, "ExcelCozum.com"
End Sub

 

[azraep]

sadece yapıştır komutu lazım bana, ilgili konuda bulamadım istediğimi yinede teşekkür ederim

Patron​

belirtiği gibi
Sadece yapıştır kodu

ActiveSheet.Range("A1:AX" & x).CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Application.Wait (Now + TimeValue("00:00:02"))
    Range("A1").Select
    ActiveSheet.Paste
    Selection.ShapeRange.Name = "Picture 1"
    ActiveSheet.Shapes("Picture 1").Copy
    Application.Wait (Now + TimeValue("00:00:02"))