Userform Image nesnesine clipboard' tan resim kopyalama

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,040
Excel Vers. ve Dili
Office 2013 İngilizce
Merhaba,

Userform açıkken; Ekran Alıntı aracından alınan görseli, Image nesnesine yapıştırmak için aşağıdaki kodu oluşturdum fakat hata veriyor,
Nasıl bir kod düzenlenebilir?

desteğiniz için şimdiden teşekkürler,
iyi akşamlar.
Kod:
Private Sub CommandButton1_Click()
 '''Worksheets("Sayfa1").Range("D3:I12").CopyPicture xlScreen, xlBitmap
 
 Me.Image1.Picture = PastePicture(xlBitmap)
End Sub
 

tamer42

Destek Ekibi
Destek Ekibi
Katılım
11 Mart 2005
Mesajlar
3,040
Excel Vers. ve Dili
Office 2013 İngilizce
Merhaba,

Userform açıkken; Ekran Alıntı aracından alınan görseli, Image nesnesine yapıştırmak için aşağıdaki kodu oluşturdum fakat hata veriyor,
Nasıl bir kod düzenlenebilir?

desteğiniz için şimdiden teşekkürler,
iyi akşamlar.
Kod:
Private Sub CommandButton1_Click()
'''Worksheets("Sayfa1").Range("D3:I12").CopyPicture xlScreen, xlBitmap

Me.Image1.Picture = PastePicture(xlBitmap)
End Sub
Tekrar merhaba,
web ortamında ekli dosyada yer alan kodu budum,
epey uzun ve karışık bir kod....
önce clipboard' da yer alan öğeyi bir klasöre resim olarak kayıt ediyor, sonra buradan image nesnesine yükleyebiliyoruz,
Burada daha önce kayıt edilen resim ile aynı isimde kayıt etmek istediğimiz zaman hata veriyor, benim istediğim ise mevcut resim dosyasını yenisiyle değiştirsin, bunu bir türlü başaramadım.
sanırım bu kod üzerinde düzenlemeler yapmak gerekecek

WIA_ConvertImage FilePathBMP, FilePathJPG, JPEG, 85

yardımlarınız için şimdiden teşekkürler,
iyi akşamlar.

Kod:
Public Sub To_Clipboard()

Dim Foldername As String
Dim FileRoot As String
Dim FilePathBMP As String
Dim FilePathJPG As String
Dim FilePathJPG2 As String
Dim sipNo As Long, item As Long

If Me.TextBox1 = "" Then Me.TextBox1 = 0
If Me.TextBox2 = "" Then Me.TextBox2 = 0

sipNo = CLng(Me.TextBox1)
item = CLng(Me.TextBox2)

Foldername = ThisWorkbook.Path & "\Foto"

' Fist check to see if a unique folder for the open record exists, create if not

If Len(Dir(Foldername, vbDirectory)) = 0 Then
   MkDir Foldername
End If

On Error GoTo reportErr
   
    FileRoot = Foldername & "\" & "Resim_" & sipNo & "_" & item
'Creates a BMP and JPG version of the filename
    FilePathBMP = FileRoot & ".bmp"
    FilePathJPG = FileRoot & ".jpg"
'Save a BMP
    SaveClip2Bit FilePathBMP
'Convert to JPG
    WIA_ConvertImage FilePathBMP, FilePathJPG, JPEG, 85
'Delete the BMP
    Kill (FilePathBMP)
    
    Load_Picture FileRoot
    
Exit Sub

reportErr:

MsgBox "No image in Clipboard"
Resume Next

End Sub
 

Ekli dosyalar

Üst