Userform içindeki resmi klasöre alma?

[hsayar]

Userform'un picture özelliğine yüklenmiş resmi;
C:\fRESIM içine almak mümkün mü?

 

[hsayar]

yardımcı olursanız sevinirim.

 

[Zeki Gürsoy]

"SavePicture" olarak aratın.

 

[hsayar]

"SavePicture" olarak aratın.

hocam onlar range için geçerli galiba, ben userform, frame yada image1 kontrollerinin picture özelliğindeki resmi c:\deneme\frame.jpg ye atmak istiyorum.

 

[hsayar]

zeki hocam googlede bir örnek buldum

mIMGCOPY adlı bir modüle;

'==================================================================================================
'        Kaynak: http://www.sqldrill.com/excel/programming-vba-vb-c-etc/
'                279245-copy-picture-image-control.html
'
'        Yazar  : Michel Pierron  - 21.01.2009
'
'        Düzen  : Hüseyin SAYAR   - 05.02.2011
'                 Resmin ne yapılacağını içerir enum tanımı eklendi.
'                 Modüle enm kontrolü eklendi.

'        Görev  : Kontrol içersindeki resmi isteğe bağlı olarak Klasöre (varsayılan)yada
'                 Aktif çalışma sayfasına bmp formatı ile kopyalar.
'
'==================================================================================================

    Private Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
    Private Declare Function EmptyClipboard Lib "user32" () As Long
    Private Declare Function SetClipboardData& Lib "user32" (ByVal wFormat&, ByVal hMem&)
    Private Declare Function CloseClipboard& Lib "user32" ()
    Private Declare Function DestroyIcon& Lib "user32" (ByVal hIcon&)

    Public Enum rsmCIKTI
      enmKLASOR = 0
      enmWKS = 1
    End Enum

    Public Sub sbRESIMKOPYALA(oCONTROL As Object, _
                                     Optional CIKTITIPI As rsmCIKTI = 0, _
                                     Optional sADVEYOL As String = "c:\a.bmp")
    On Error Resume Next
      Dim iPic As StdPicture, hCopy&
      Set iPic = oCONTROL.Picture
      OpenClipboard 0&: EmptyClipboard
      hCopy = SetClipboardData(2, iPic.Handle)
      CloseClipboard
        If hCopy Then
          If CIKTITIPI = enmWKS Then
            'Çalışma Sayfasına kopyalarız
            ActiveSheet.Cells(1, 1).Select
            ActiveSheet.Paste
          Else
            'hardiske kopyalarız
            'On Error Resume Next
            Kill sADVEYOL
            SavePicture iPic, sADVEYOL
          End If
        End If
        
        
      DestroyIcon iPic.Handle
      Set iPic = Nothing
    End Sub

usetforma

Private Sub CommandButton1_Click()
'Call mIMGCOPY.sbRESIMKOPYALA(Me, "C:\A.BMP")
Call mIMGCOPY.sbRESIMKOPYALA(Me, , "c:\k.bmp")
Call mIMGCOPY.sbRESIMKOPYALA(Me, enmWKS)
End Sub

yazdım ancak iki açmazım var. resmi kopyalamıyor kesiyor yani kontrolden resmi kaldırıyor. (commandbuton transparent olduğu için griye dönüyor)
jpg olarak kaydetmek mümkün mü?

 

[Husgvarna]

Aşağıdaki örnek işinize yararmı ?

 

[Levent Menteşoğlu]

Zeki beyin önerdiği savepicture komutu ile bunu kolaylıkla yapabilirsiniz. Öyle uzun kodlara gerek yok.

SavePicture Image1.Picture, "c:\deneme\frame.jpg"

Not: Sn Husgvarna'da aynı çözümü önermiş. Mesajımı örnek dosyayı incelemeden göndermiştim.

 

[hsayar]

Aşağıdaki örnek işinize yararmı ?

Zeki beyin önerdiği savepicture komutu ile bunu kolaylıkla yapabilirsiniz. Öyle uzun kodlara gerek yok.

SavePicture Image1.Picture, "c:\deneme\frame.jpg"

Not: Sn Husgvarna'da aynı çözümü önermiş. Mesajımı örnek dosyayı incelemeden göndermiştim.

teşekkürler.

 

[hsayar]

Hocam peki kırparak kaydetmek mümkün mü?
yani userform1.picture içindeki resmi sağdan 15 soldan 50 üstten 25 alttan 50 ölçek(artık width, heigt özelliğindeki ölçek ne ise olmadı pixel) kırparak kaydedecek.

 

[hsayar]

Hocam peki kırparak kaydetmek mümkün mü?
yani userform1.picture içindeki resmi sağdan 15 soldan 50 üstten 25 alttan 50 ölçek(artık width, heigt özelliğindeki ölçek ne ise olmadı pixel) kırparak kaydedecek.


güncel