userformdaki resmi farklı bir sayfa hücresine aktarma?

[anita]

bilgiler ekte verilmiştir iyi çalışmalar.

 

[anita]

güncel

konu ile ilgili bilgisi olan yok mu?

 

[halit3]

Userforma bir adet komut düğmesi ekle ve aşağıdaki kodu çalıştır.

Not :kod userformun üstündeki image nesnesindeki resimi alınan malar sayfasındaki userforma aktarıyor

Private Sub CommandButton2_Click()

Dim s1
Dim Yeni_Resim As OLEObject
Dim Adres As Range
Set s1 = Sheets("alınan malar")
sat1 = 3
sat2 = 3
sut1 = "P"
sut2 = "Q"
Set Adres = Sheets("alınan malar").Range(Sheets("alınan malar").Cells(sat1, sut1).Address, Sheets("alınan malar").Cells(sat2, sut2).Address)
Say = 0
Dim Picture As Object
For Each Picture In Sheets("alınan malar").Shapes
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object) = "OLEObject" Then
If TypeName(s1.Shapes(Picture.Name).OLEFormat.Object.Object) = "Image" Then
If Not Intersect(Sheets("alınan malar").Range(Picture.TopLeftCell.Address & ":" & Picture.BottomRightCell.Address), Adres) Is Nothing Then
Say = Say + 1
Sheets("alınan malar").Image1.Picture = form.Image1.Picture
Exit For
End If
End If
End If
Next Picture

If Say = 0 Then
Set Yeni_Resim = Sheets("alınan malar").OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, _
DisplayAsIcon:=False, Left:=Adres.Left, Top:=Adres.Top, Width:=Adres.Width, Height:=Adres.Height)
With Yeni_Resim
.Top = Adres.Top + 1
.Left = Adres.Left + 1
.Height = Adres.Height - 1
.Width = Adres.Width - 1
.Object.PictureSizeMode = fmPictureSizeModeStretch
.Object.Picture = form.Image1.Picture
Application.Wait (Now + TimeValue("0:00:1"))
End With

End If
MsgBox "işlem tamam"
End Sub