• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Web sayfasının ekran görüntüsünü almak

J

Jeeday

Katılım
7 Mayıs 2006
Mesajlar
367
Excel Vers. ve Dili
2019 İngilizce
Merhabalar,

Belli bir web sayfasının ekran görüntüsünü alıp aktif olan safyanın A1 hücresine yapıştırmak istiyorum.

Birkaç kod denedim fakat hep vb ekranının görüntüsünü alıp aktarıyor.

Teşekkürler
 
Merhaba

Klavyeden PrintScreen (Prt Scr) tuşuna basıldığında o anki ekran görüntüsü hafızaya alınır.
Sonra Excelde A1 hücresine sağ tıklayıp Yapıştır komutu tıklandığında görüntü yapışır.

Selamlar...
 
kulomer46' Alıntı:
Merhaba

Klavyeden PrintScreen (Prt Scr) tuşuna basıldığında o anki ekran görüntüsü hafızaya alınır.
Sonra Excelde A1 hücresine sağ tıklayıp Yapıştır komutu tıklandığında görüntü yapışır.

Selamlar...
Genişletmek için tıkla ...
:))))

Belli saatlerde yapılması için bu işi programlayacağız. Manuel olmayacak kısacası :)
 
Selenium Basic kullanın 1 satırlık kod.
Kod: 
driver.TakeScreenshot.ToExcel [a1]
 

Çözüldü - Web sitesine şifreli girişi onaylatmak

Merhaba arkadaşlar; https://cloud.acrobat.com Bu web sitesine alttaki verdiğim kod ile açıyorum. Dim iRet As Long Dim cevap As Integer cevap = MsgBox("Adobe document web sitesini açmak istiyormusunuz?", vbInformation + vbYesNo, "Adobe Scan (Iphone)") Select Case cevap Case vbYes ShellExecute...
www.excel.web.tr www.excel.web.tr
 
veyselemre' Alıntı:

Çözüldü - Web sitesine şifreli girişi onaylatmak

Merhaba arkadaşlar; https://cloud.acrobat.com Bu web sitesine alttaki verdiğim kod ile açıyorum. Dim iRet As Long Dim cevap As Integer cevap = MsgBox("Adobe document web sitesini açmak istiyormusunuz?", vbInformation + vbYesNo, "Adobe Scan (Iphone)") Select Case cevap Case vbYes ShellExecute...
www.excel.web.tr www.excel.web.tr
Genişletmek için tıkla ...
Çok güzel ama şu an için Selenium'u çözmek için yeterli zamana sahip değilim. Yine de fikir için teşekkürler
 
Web sayfasını hangi tarayıcı ile açıyorsunuz?
 
Çok eskiden kullamdığım Iescreenshotinstaller veya Iescreenshotproinstaller programlarını deneyebilirsiniz. Ekran görüntüsünü değil web sayfasının tamamını resim olarak kaydeder. Belki şu an daha iyileri çıkmıştır.
 
Biraz netten araştırdım ve aşağıdaki kodlara ulaştım. Biraz revize ederek paylaşıyorum.

Explorer ile çalışmaktadır..

C++: 
Option Explicit

Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Const VK_SNAPSHOT As Byte = 44
Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_KEYUP = &H2

Sub Web_Sayfa_Resmini_Al()
    Dim IE As Object, Kitap_Adi As String
    Dim Pencere_No As Long, Web_Pencere_Adi As String

    Kitap_Adi = ActiveWorkbook.Name

    Set IE = CreateObject("InternetExplorer.Application")

    IE.Visible = True

    IE.Navigate "www.excel.web.tr"

    Do Until IE.ReadyState = 4: DoEvents: Loop
    
    Web_Pencere_Adi = IE.LocationName & " - Internet Explorer"

    Pencere_No = FindWindow(vbNullString, Web_Pencere_Adi)

    If Pencere_No = 0 Then
        MsgBox "Web sayfasına ulaşılamıyor!"
        Exit Sub
    Else
        ShowWindow Pencere_No, SW_SHOWMAXIMIZED
    End If
    
    DoEvents
    Sleep 1000

    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)

    AppActivate Kitap_Adi
    
    DoEvents
    Sleep 1000
    SendKeys "^v", True

    MsgBox "Web sayfasının resmi excel sayfasına aktarılmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Biraz netten araştırdım ve aşağıdaki kodlara ulaştım. Biraz revize ederek paylaşıyorum.

Explorer ile çalışmaktadır..

C++: 
Option Explicit

Private Declare Sub keybd_event Lib "user32.dll" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Private Const VK_SNAPSHOT As Byte = 44
Private Const SW_SHOWMAXIMIZED = 3
Private Const VK_LCONTROL As Long = &HA2
Private Const VK_V = &H56
Private Const KEYEVENTF_KEYUP = &H2

Sub Web_Sayfa_Resmini_Al()
    Dim IE As Object, Kitap_Adi As String
    Dim Pencere_No As Long, Web_Pencere_Adi As String

    Kitap_Adi = ActiveWorkbook.Name

    Set IE = CreateObject("InternetExplorer.Application")

    IE.Visible = True

    IE.Navigate "www.excel.web.tr"

    Do Until IE.ReadyState = 4: DoEvents: Loop
   
    Web_Pencere_Adi = IE.LocationName & " - Internet Explorer"

    Pencere_No = FindWindow(vbNullString, Web_Pencere_Adi)

    If Pencere_No = 0 Then
        MsgBox "Web sayfasına ulaşılamıyor!"
        Exit Sub
    Else
        ShowWindow Pencere_No, SW_SHOWMAXIMIZED
    End If
   
    DoEvents
    Sleep 1000

    Call keybd_event(VK_SNAPSHOT, 0, 0, 0)

    AppActivate Kitap_Adi
   
    DoEvents
    Sleep 1000
    SendKeys "^v", True

    MsgBox "Web sayfasının resmi excel sayfasına aktarılmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Şu satırda hata verdi...

*** AppActivate Kitap_Adi

Run-time error '5'
Invalid procedure call or argument...
 
veyselemre' Alıntı:
Yol mutlaka vardır da siz hiç bir şey açıklamadan yanıt almaya çalışıyorsunuz. Neyi denediniz, neyle almak istiyorsunuz? Hangi sayfayı almak istiyorsunuz?
Genişletmek için tıkla ...

Excel vba ile "www.excel.web.tr" linkine "Chrome" ya da "IE" ile girip ilk çıkan sayfanın ekran görüntüsünü alıp Excel'in "Sheet1" sayfasının A1 hücresine bu ekran görüntüsünü yapıştırmak istiyorum....

Hangi link'e gireceğinin önemi yok. O benim tarafımdan belirlenecek...

Chrome ya da IE ile Excel arasındaki geçişi sağlayamadığımdan hep sorun çıkıyor. Korhan Bey'in verdiği kodda aynı sorundan takılıyor...
 
Kitap_Adi = Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & " - Excel"

şeklinde düzeltince kod takılmadı....
 
Kod takılmadı fakat görsel yapıştırılmadan işlem bitiyor...
 
SendKeys "^V", True

bunun yerine

Range("A1").Select
ActiveSheet.Paste

kullanınca işlem tamam
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst