UserForm'a Resim Getirip CommandButton ile Hücreye yapıştırma

[cocoa35]

Merhaba üstatlar ekli örnek dosyada UserForm'a bilgisayardaki herhangi bir resmi alabiliyorum ancak userform üstündeki commandbutton ile o resmi hücreye göndermek istiyorum ama kod hata veriyor nasıl düzeltilebilir acaba?

 

[cocoa35]

Merhaba üstatlar ekli örnek dosyada UserForm'a bilgisayardaki herhangi bir resmi alabiliyorum ancak userform üstündeki commandbutton ile o resmi hücreye göndermek istiyorum ama kod hata veriyor nasıl düzeltilebilir acaba?

Bu konuda yardım lütfen

 

[halit3]

Kodun çalışması için referanslara clipbrd.dll dosyası yüklü olmalı

Private Sub CommandButton2_Click()

Dim myClp As Object

Set myClp = CreateObject("clipbrd.clipboard")
myClp.Clear
myClp.setData UserForm1.Image1.Picture, 2 '‘The 2 is for bitmaps

If Not Image1.Picture Is Nothing Then
myClp.setData Image1.Picture
Else
MsgBox "Resim yok"
Exit Sub
End If

Worksheets(ActiveSheet.Name).Paste Destination:=Worksheets(ActiveSheet.Name).Range("d8")
say = Worksheets(ActiveSheet.Name).Shapes.Count
ad1 = Worksheets(ActiveSheet.Name).Shapes(say).Name



Dim sat, sat2, sut, sut2
sut = 4
sat = 8
sut2 = 7
sat2 = 16

Set adres = Worksheets(ActiveSheet.Name).Range(Worksheets(ActiveSheet.Name).Range(Worksheets(ActiveSheet.Name).Cells(sat, sut), Worksheets(ActiveSheet.Name).Cells(sat2, sut2)).Address)

Worksheets(ActiveSheet.Name).Shapes(ad1).OLEFormat.Object.Top = adres.Top + 2
Worksheets(ActiveSheet.Name).Shapes(ad1).OLEFormat.Object.Left = adres.Left + 2
Worksheets(ActiveSheet.Name).Shapes(ad1).OLEFormat.Object.ShapeRange.LockAspectRatio = msoFalse
Worksheets(ActiveSheet.Name).Shapes(ad1).OLEFormat.Object.ShapeRange.Height = adres.Height - 4
Worksheets(ActiveSheet.Name).Shapes(ad1).OLEFormat.Object.ShapeRange.Width = adres.Width - 4

MsgBox "Soru kağıda aktarıldı.", vbInformation, "      Bilgi"

End Sub

 

[cocoa35]

Merhaba Halit3 "clipbrd.dll " dosyasını nasıl referanslara yüklerim baktım listede yok

 

[halit3]

size bir adet clipboard.dll dosyası gönderiyorum bunu
c:\windows\SysWOW64\ ve c:\windows\System32\ dosyalarına kopyalayın.

daha sonra aşağıdaki işlemleri yapın

Bilgisayardan başlangıçdaki uygulamalardan cmd yazıp arama yaparak komut istemi dosyasını yönetici olarak aç.

1-klasöre giriş
cd c:\windows\SysWOW64\
yazım entere basın sonra altdaki bölümü yapıştırın ve entere basın
regsvr32 c:\windows\SysWOW64\clipboard.dll


2-klasöre giriş
cd c:\windows\System32\
yazım entere basın sonra altdaki bölümü yapıştırın ve entere basın
regsvr32 c:\windows\System32\clipboard.dll

not: komut istemi dosyasını yönetici olarak çalıştırmazsanız bu işlemler olmaz.

 

[cocoa35]

Tamam çok teşekkürler