Load Shape của Sheet lên Button của Form (1 người xem)

viehoai · 3/12/12

Để load hình ảnh của file (.bmp) lên button của form tôi dùng code

Mã:

Private Sub UserForm_Initialize()
  Me.CommandButton1.Picture = LoadPicture("C:\hinh.bmp")
End Sub

Vậy xin hỏi các anh chị với sự kiện trên code nào để load Shape có tên Sh1 ở Sheet1 lên CommandButton1
Xin cảm ơn các anh chị

ndu96081631 · 3/12/12

viehoai đã viết:
Để load hình ảnh của file (.bmp) lên button của form tôi dùng code

Mã:

Private Sub UserForm_Initialize() Me.CommandButton1.Picture = LoadPicture("C:\hinh.bmp") End Sub

Vậy xin hỏi các anh chị với sự kiện trên code nào để load Shape có tên Sh1 ở Sheet1 lên CommandButton1
Xin cảm ơn các anh chị

Việc đầu tiên là phải lưu shape thành 1 file trên ổ cứng
1> Code trong module

PHP:

Private Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(0 To 7) As Byte
End Type
 
Private Type uPicDesc
  Size As Long
  Type As Long
  hPic As Long
  hPal As Long
End Type
     
Private Declare Function IsClipboardFormatAvailable Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Integer) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As uPicDesc, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" (ByVal hemfSrc As Long, ByVal lpszFile As String) As Long
Private Declare Function CopyImage Lib "user32" (ByVal handle As Long, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long

PHP:

Function PictureFromObject(Target As Object) As IPictureDisp
  Dim hPtr As Long, PicType As Long, hCopy As Long
  Const CF_BITMAP = 2
  Const CF_PALETTE = 9
  Const CF_ENHMETAFILE = 14
  Const IMAGE_BITMAP = 0
  Const LR_COPYRETURNORG = &H4
  Const PICTYPE_BITMAP = 1
  Const PICTYPE_ENHMETAFILE = 4
  Target.CopyPicture
  PicType = IIf(IsClipboardFormatAvailable(CF_BITMAP) <> 0, CF_BITMAP, CF_ENHMETAFILE)
  If IsClipboardFormatAvailable(PicType) <> 0 Then
    If OpenClipboard(0) > 0 Then
      hPtr = GetClipboardData(PicType)
      If PicType = CF_BITMAP Then
        hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
      Else
        hCopy = CopyEnhMetaFile(hPtr, vbNullString)
      End If
      CloseClipboard
      If hPtr <> 0 Then
        Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPictureDisp
        With IID_IDispatch
          .Data1 = &H7BF80980
          .Data2 = &HBF32
          .Data3 = &H101A
          .Data4(0) = &H8B
          .Data4(1) = &HBB
          .Data4(2) = &H0
          .Data4(3) = &HAA
          .Data4(4) = &H0
          .Data4(5) = &H30
          .Data4(6) = &HC
          .Data4(7) = &HAB
        End With
        With uPicInfo
          .Size = Len(uPicInfo)
          .Type = IIf(PicType = CF_BITMAP, PICTYPE_BITMAP, PICTYPE_ENHMETAFILE)
          .hPic = hCopy
        End With
        OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
        Set PictureFromObject = IPic
      End If
    End If
  End If
End Function

2> Code cho CommandButton:

PHP:

Private Sub CommandButton1_Click()
  Dim Pic As String, shp As Shape
  On Error Resume Next
  Set shp = Sheet1.Shapes("sh1") ''<--- Xác định shape trên bảng tính
  If Not shp Is Nothing Then
    With CreateObject("Scripting.FileSystemObject")
      Pic = "C:\" & .GetTempName & ".bmp" ''<---- đặt tên shape 1 cách ngẫu nhiên
      SavePicture PictureFromObject(shp), Pic ''<--- Save shape thành picture
      Me.CommandButton1.Picture = LoadPicture(Pic)
      .DeleteFile Pic
    End With
  Else
    MsgBox "Không tìm thay shape nào!"
  End If
End Sub

viehoai · 3/12/12

ndu96081631 đã viết:
Việc đầu tiên là phải lưu shape thành 1 file trên ổ cứng

Không ngờ việc tưởng chừng đơn giản phải đi 1 vòng như thế phức tạp thật
Em cảm ơn rất nhiều, cũng biết thêm cách lưu Shape thành file *.bmp

ndu96081631 · 3/12/12

viehoai đã viết:
Không ngờ việc tưởng chừng đơn giản phải đi 1 vòng như thế phức tạp thật
Em cảm ơn rất nhiều, cũng biết thêm cách lưu Shape thành file *.bmp

Tôi đã tìm hiểu và phát hiện ra 1 cách còn đơn giản hơn
- Đầu tiên tải file Clipboard.RAR dưới đây về, giải nén, được file clipboard.dll
- Copy file clipboard.dll cho vào thư mục C:\Windows\System32
- Xong đăng ký file dll này bằng cách: Start\Run, gõ lệnh: regsvr32 clipboard.dll rồi Enter. Nếu thấy thông báo đăng ký thành công thì có thể tiếp tục công đoạn dưới
----------------------------------
- Khởi động file Excel của bạn, cho code dưới đây vào 1 Module

PHP:

Function PictureFromObject(Target As Object) As IPictureDisp
  On Error Resume Next
  If Not Target Is Nothing Then
    Target.CopyPicture
    Set PictureFromObject = CreateObject("clipbrd.clipboard").GetData(14)
  End If
End Function

- Code cho CommandButton như cũ

Bạn test giúp tôi nhé
(Hình như máy nào có cài VB6 thì file clipboard.dll đã có sẵn thì phải)

siwtom · 3/12/12

viehoai đã viết:
Không ngờ việc tưởng chừng đơn giản phải đi 1 vòng như thế phức tạp thật
Em cảm ơn rất nhiều, cũng biết thêm cách lưu Shape thành file *.bmp

Nếu làm như ndu thì cũng chả phải ghi lên đĩa rồi đọc từ đĩa:

Mã:

Private Sub UserForm_Initialize()
    Me.CommandButton1.Picture = PictureFromObject(Sheet1.Shapes("sh1"))
End Sub

----------------
Nếu cái Shape kia là Image - thẻ Developer --> Insert --> ActiveX Controls --> Image thì cũng chả cần Shape.CopyPicture vào Clipboard rồi lại đọc ra từ Clipboard làm gì.
Module:

Mã:

Function GetPictureObject(ByVal Image As String, Optional ByVal loadOpt As Long = 0, Optional obj As Object = Nothing) As IPictureDisp
'   loadOpt = 0 --> image là đường dẫn tới tập tin ảnh trên đĩa,
'   loadOpt = 1 --> image là index của ảnh trong ImageList và obj là ImageList
'   loadOpt <> 0 và loadOpt <> 1--> image là tên của ảnh trên Sheet và obj là tên Sheet đó
Dim pic As MSForms.Image
Dim objOLE As OLEObject
    On Error GoTo error_
    
    If loadOpt = 0 Then
'        đọc từ đĩa
        Set GetPictureObject = LoadPicture(Image)
    ElseIf loadOpt = 1 Then
'        đọc từ ImageList
        If Not obj Is Nothing Then
            Set GetPictureObject = obj.ListImages(CLng(Image)).Picture
        End If
    Else
'        lay từ Sheet
        If Not obj Is Nothing Then
            Set objOLE = obj.OLEObjects(Image)
            If objOLE.progID = "Forms.Image.1" Then
                Set pic = objOLE.Object
                Set GetPictureObject = pic.Picture
            End If
            Set objOLE = Nothing
            Set pic = Nothing
        End If
    End If
error_:
End Function

UserForm:

Mã:

Private Sub UserForm_Initialize()
    Me.CommandButton1.Picture = GetPictureObject("sh1", 2, Sheet1)
End Sub

Dùng hàm GetPictureObject có thể nhập ảnh từ tập tin trên đĩa, từ ImageList và từ Image trên Sheet.

Về cái DLL của ndu thì cũng dễ hiểu thôi. "Người ta" cũng phải đọc từ Clipboard như mình. Mình không "đọc" thì phải dùng DLL của người ta để đọc, nhưng đi đâu cũng phải mang DLL theo rồi copy, đăng ký vào system. Mình tự làm thì chả phải mang theo cái gì cả.

À mà SavePicture thì cũng chỉ save thành BMP mà thôi. Không save được thành JPG cho dù trước đó nhập vào Shape ảnh JPG.

ndu96081631 · 3/12/12

siwtom đã viết:
Nếu làm như ndu thì cũng chả phải ghi lên đĩa rồi đọc từ đĩa:

Mã:

Private Sub UserForm_Initialize() Me.CommandButton1.Picture = PictureFromObject(Sheet1.Shapes("sh1")) End Sub

Cái này bây giờ mới biết
Em cứ tưởng nó chỉ lấy được Picture từ file trên đĩa thôi chứ

siwtom đã viết:
À mà SavePicture thì cũng chỉ save thành BMP mà thôi. Không save được thành JPG cho dù trước đó nhập vào Shape ảnh JPG.

Ủa, em test code của em ở trên, SavePicture thành file JPG cũng đâu có vấn đề gì đâu anh?

siwtom · 3/12/12

ndu96081631 đã viết:
Cái này bây giờ mới biết
Em cứ tưởng nó chỉ lấy được Picture từ file trên đĩa thôi chứ

Ủa, em test code của em ở trên, SavePicture thành file JPG cũng đâu có vấn đề gì đâu anh?

Nói chính xác thì:
Nếu trong Picture có Metafile thì sau khi SavePicture Tuấn có MetaFile cho dù Tuấn chọn tên ghi là bla.emf, bla.bmp, bla.jpg, bla.gif, bla.txt, bla.avi, bla (không có "đuôi")
Nếu trước đó nhập vào Picture JPG, GIF, BMP thì sau khi SavePicture Tuấn có BMP cho dù Tuấn chọn tên ghi là bla.emf, bla.bmp, bla.jpg, bla.gif, bla.txt, bla.avi, bla (không có "đuôi")
------------
Tuấn có thể đổi tên bla.avi thành bla.txt nhưng lõi của nó vẫn là AVI chứ không phải là TXT. Do lõi thực không phải là TXT nên Tuấn không thể click để mở xem AVI. Vì mặc định thì system sẽ dùng notepad để mở TXT. Khi Tuấn click bla.txt thì system sẽ dùng notepad để mở bla.txt, vì sytem đâu có kiểm tra "lõi" của tập tin. Nhưng notepad không thể mở được bla.txt vì lõi của nó thực ra là dạng AVI chứ không phải TXT. Nếu Tuấn chuột phải rồi chọn "Open with" rồi chọn Media Player thì nó mở phim cho TUấn xem vì "lõi" đúng là AVI, cái "đuôi" TXT kia không quan trọng.
"Đuôi" chỉ là để nhận biết dạng tập tin, nhưng là kiểu: Tôi tin là anh có đuôi thế thật. Lõi mới là quan trọng. Lõi dạng nào thì tập tin có dạng thế thật. Nếu tôi "dùng" tên "Nguyễn Thị Diễm My" thì "người ta tưởng tôi là con gái nhưng khi "lâm trận" thì "lõi" thế nào nó lòi ra ngay.
------------
Tuấn dùng SavePicture có thể nhập tên: bla.bmp, bla.jpg, bla.gif, thậm chí bla.TXT hay bla (không có "đuôi") thì Tuấn sẽ có trên đĩa bla.bmp, bla.jpg, bla.gif, thậm chí bla.TXT hay bla, SavePicture chấp nhận bất cứ tên nào. Nhưng lõi luôn là BMP.
Tuấn có thể mở tập tin đã ghi, vd. bla.txt, bla bằng Paint (vd. mở Paint --> File --> Open --> chọn All Files --> duyệt tới bla.txt hoặc bla). Tuấn có thể mở bla.txt, bla bằng HexEditor thì Tuấn thấy 2 bai đầu là 42 và 4D - "BM". "BM" là signature của tập tin BMP. Nếu Tuấn mở tập tin JPG thì Tuấn sẽ có ở dòng đầu "JFIF". Phần lớn các định dạng đều có signature để nhận biết. Tập tin RAR thì chắc 3 bai đầu là "Rar".
Mà Tuấn có thể mở tập tin mà Tuấn ghi là bla.jpg (dùng SavePicture) bằng Paint rồi ghi lại thành hic.jpg. Khi mở bla.jpg bằng HexEditor thì Tuấn thấy "BM" còn khi mở hic.jpg thì Tuấn có "JFIF". Tức hic.jpg đúng là JPG còn bla.jpg chỉ là tên trá hình thôi còn "đồ" là BMP.

ndu96081631 · 3/12/12

siwtom đã viết:
Nói chính xác thì:
Nếu trong Picture có Metafile thì sau khi SavePicture Tuấn có MetaFile cho dù Tuấn chọn tên ghi là bla.emf, bla.bmp, bla.jpg, bla.gif, bla.txt, bla.avi, bla (không có "đuôi")
Nếu trước đó nhập vào Picture JPG, GIF, BMP thì sau khi SavePicture Tuấn có BMP cho dù Tuấn chọn tên ghi là bla.emf, bla.bmp, bla.jpg, bla.gif, bla.txt, bla.avi, bla (không có "đuôi")
.

Nhân việc anh nói về MetaFile, em hỏi thêm:
- Trong clipbrd.clipboard Object (clipboard.dll) có phương thức GetData(Format as ClipboardConstants)
- ClipboardConstants có vbCFMetafile = 3 và vbCFEMetafile = 14
Em không biết 2 thằng em vbCFMetafile và vbCFEMetafile có gì khác nhau? Vì em test cả 2 thấy đều ra kết quả (nói chung là em không phân biệt được)
--------------------
Thật lòng mà nói: Code toàn là thu thập các nơi + mò mẫm nên nhiều thứ còn ngu ngơ lắm anh à

siwtom · 3/12/12

ndu96081631 đã viết:
Nhân việc anh nói về MetaFile, em hỏi thêm:
- Trong clipbrd.clipboard Object (clipboard.dll) có phương thức GetData(Format as ClipboardConstants)
- ClipboardConstants có vbCFMetafile = 3 và vbCFEMetafile = 14
Em không biết 2 thằng em vbCFMetafile và vbCFEMetafile có gì khác nhau? Vì em test cả 2 thấy đều ra kết quả (nói chung là em không phân biệt được)
--------------------
Thật lòng mà nói: Code toàn là thu thập các nơi + mò mẫm nên nhiều thứ còn ngu ngơ lắm anh à

Trong Windows thì có các hằng số:
CF_ENHMETAFILE = 14 - vbCFEMetafile - có E
CF_METAFILEPICT = 3 - vbCFMetafile - không có E
---------------
Có 2 loại metafile:
1. Ảnh "mua_xuan.wmf" - Windows Metafile Format
2. Ảnh "mua_xua.emf" - Enhanced Metafile Format (thường gặp)
--------------
Khi trong cliipboard có Format = 3 thì có nghĩa là có Windows Metafile Format, nếu có Format = 14 thì có nghĩa là có Enhanced Metafile Format
-----------
Trong Clipboard có thể có đồng thời nhiều Format. Vd. ta copy text trong Excel thì trong clipboard có thể có OEM text (format = 7), text (format = 1), unicode text (format = 13) và sau khi kiểm tra và tùy vào nhu cầu ta có thể đọc ra OEM text, text hoặc unicode text.
Khi ta mở trang web và copy cả trang hoặc một đoạn thì trong clipboard cũng có nhiều format mà chắc chắn 1 trong số đó là "HTML Format".
-------------
Tuấn mở help của tôi hoặc cái đã tải về và xem mục "Set(Get)ClipboardData". Tất nhiên trong clipboard còn có nhiều format hơn là được liệt kê trong help. Ví dụ có format "HTML Format" - vd. khi ta copy vùng trong Excel thì trong clipboard có đồng thời: Bitmap (BMP), WMF, EMF, Richedit format, unicode format, text format, HTML format (có nhiều format nên sau khi copy nếu ta mở WORD thì trong menu "Paste Special" ta có nhiều lựa chọn là vì thế). Tuấn còn có thể tạo 1 cấu trúc dữ liệu rồi copy dữ liệu vào clipboard để rồi sau đó đọc ra. Tất nhiên trước khi copy vào clipboard thì phảii đăng ký format của mình - RegisterClipboardFormat. Và tất nhiên "người khác" cũng có thể đọc ra dữ liệu của Tuấn nhưng do không biết cấu trúc dữ liệu như thế nào nên có được 1 chuỗi bai" thì cũng vô ích.

ndu96081631 · 4/12/12

Còn 1 vấn đề nữa em muốn hỏi:
- Code ở bài 5 của anh chỉ là load image từ file, image list hoặc image control mà thôi
- Đặt trường hợp không dùng đến clipboard.dll, em rất muốn biết anh sẽ viết code để convert shape thành IPictureDisp như thế nào? Hay là phải dùng đến code dài thòng lòng (API) như ở bài 2
- Có cách nào đơn giản hóa code nữa không? Em chỉ quan tâm đến trường hợp object là 1 shape trên bảng tính, còn các trường hợp khác (từ file, image list, image control...) em không quan tâm

siwtom · 4/12/12

ndu96081631 đã viết:
Còn 1 vấn đề nữa em muốn hỏi:
- Code ở bài 5 của anh chỉ là load image từ file, image list hoặc image control mà thôi
- Đặt trường hợp không dùng đến clipboard.dll, em rất muốn biết anh sẽ viết code để convert shape thành IPictureDisp như thế nào? Hay là phải dùng đến code dài thòng lòng (API) như ở bài 2
- Có cách nào đơn giản hóa code nữa không? Em chỉ quan tâm đến trường hợp object là 1 shape trên bảng tính, còn các trường hợp khác (từ file, image list, image control...) em không quan tâm

Nếu tôi không lầm thì không thể đọc được IPictureDisp.
Shape có muôn vàn loại. Đặt xuống sheet 1 đối tượng OLE như Image ta có shape. Đặt Picture (Insert --> Picture) ta cũng có shape. Đặt Oval (Insert --> Shape), Button, Drop Down, List Box, Check Box, Label xuống sheet cũng có shape.
Trong trường hợp những đối tượng kể trên, trừ Image, làm gì có IPictureDisp để mà "lấy". Chỉ có Image là OLE object với thuộc tính Picture.
Vậy nếu không là Image thì tôi cũng sẽ viết code như PictureFromObject ở bài #2. Chính vì thế tôi viết rõ ở bài #5: Nếu cái Shape kia là Image

ndu96081631 · 5/12/12

Em lại hơi tham vọng tí khi có ý định muốn load Shape vào Image list
Có điều sau khi convert shape thành IPictureDisp thì thằng Image List nó không chấp nhận loại này (hình như nó chỉ khoái Bitmap chứ không ưa Metafile)
Xin anh siwtom cho ý kiến giúp em về vấn đề này với
(Cứ có cảm giác chỉ còn 1 bước nữa là lên tới mây, vậy mà lại tuột xuống vực mất rồi ---> Rất bực!)

ndu96081631 · 5/12/12

ndu96081631 đã viết:
Em lại hơi tham vọng tí khi có ý định muốn load Shape vào Image list
Có điều sau khi convert shape thành IPictureDisp thì thằng Image List nó không chấp nhận loại này (hình như nó chỉ khoái Bitmap chứ không ưa Metafile)
Xin anh siwtom cho ý kiến giúp em về vấn đề này với
(Cứ có cảm giác chỉ còn 1 bước nữa là lên tới mây, vậy mà lại tuột xuống vực mất rồi ---> Rất bực!)

Ôi... thôi em phát hiện ra rồi ---> Tất cả là do thằng Format mà ra. Thay vì GetData(14) ta sửa thành GetData(8)
Ở đây em dùng clipboard.dll, còn nếu vẫn dùng các hàm API như bài 2 thì em chưa biết phải sửa lại thế nào nữa. Anh siwtom suy nghĩ giúp em vấn đề này với (dù sao vẫn khoái tự viết hơn là dùng file dll của người khác)
----------------
Xin đính kem file dưới đây file Image Combo ----> Các bạn tải về, giải nén và test giúp nhé

siwtom · 5/12/12

ndu96081631 đã viết:
Ôi... thôi em phát hiện ra rồi ---> Tất cả là do thằng Format mà ra. Thay vì GetData(14) ta sửa thành GetData(8)
Ở đây em dùng clipboard.dll, còn nếu vẫn dùng các hàm API như bài 2 thì em chưa biết phải sửa lại thế nào nữa. Anh siwtom suy nghĩ giúp em vấn đề này với (dù sao vẫn khoái tự viết hơn là dùng file dll của người khác)

Thì Bitmap ImageList nó cũng chấp nhận chứ.
Vậy thì code trong bài #2 là được rồi còn gì.
8 tức DIB - device-independent bitmap
-----------
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const CF_DIB = 8
...
Nhưng lấy CF_BITMAP = 2 là được rồi.

ndu96081631 · 5/12/12

siwtom đã viết:
Thì Bitmap ImageList nó cũng chấp nhận chứ.
Vậy thì code trong bài #2 là được rồi còn gì.
8 tức DIB - device-independent bitmap
-----------
Const CF_BITMAP = 2
Const CF_PALETTE = 9
Const CF_ENHMETAFILE = 14
Const CF_DIB = 8
...
Nhưng lấy CF_BITMAP = 2 là được rồi.

Sao em test hàm ở bài 2 mà chẳng thấy ăn thua gì, nó cứ báo lỗi Invalid Picture
Em gửi nguyên file, anh xem giúp em với
(vì không hiểu nên "quậy" lung tung, hên thì trúng...)

ndu96081631 · 5/12/12

ndu96081631 đã viết:
Sao em test hàm ở bài 2 mà chẳng thấy ăn thua gì, nó cứ báo lỗi Invalid Picture
Em gửi nguyên file, anh xem giúp em với
(vì không hiểu nên "quậy" lung tung, hên thì trúng...)

Ôi... cha Bill lại xui xẻo để mình "vọc".. trúng nữa rồi
Chỉ cần sửa:
Target.CopyPicture
Thành:
Target.CopyPicture xlScreen, xlBitmap
là xong!
hoặc vầy cũng được:
Target.CopyPicture , xlBitmap
(ăn tiền chổ xlBitmap ấy, mặc định không ghi gì thì nó là xlPicture)
Tự "vọc" mà nó "ra" 1 phát, đúng là sướớớớớớớng hơn cưới được vợ bốn...
Ẹc... Ẹc...
Bài này ứng dụng cho các bạn TRA CỨU THÉP HÌNH thì quá OK luôn
----------------------------
Các bạn có tải file dưới đây về, nếu test thấy OK cũng nhớ phản hồi cho mình biết với nhé!
Cảm ơn!

siwtom · 5/12/12

ndu96081631 đã viết:
Ôi... cha Bill lại xui xẻo để mình "vọc".. trúng nữa rồi
Chỉ cần sửa:
Target.CopyPicture
Thành:
Target.CopyPicture xlScreen, xlBitmap
là xong!
hoặc vầy cũng được:
Target.CopyPicture , xlBitmap
(ăn tiền chổ xlBitmap ấy, mặc định không ghi gì thì nó là xlPicture)
Tự "vọc" mà nó "ra" 1 phát, đúng là sướớớớớớớng hơn cưới được vợ bốn

Sướng mà hét dài thế thì chắc là cực sướng đây.

viehoai · 9/12/12

Xin lỗi các anh chị, từ khi nhận được kết quả bài 2 của anh ndu96081631 em đột xuất đi Gia Lai nay mới về cũng chưa kịp test hết các bài các anh chị

ndu96081631 · 10/12/12

Sau khi xem lại thật kỹ hàm PictureFromObject, tôi có nhận xét thế này:
- Nếu sửa đoạn Target.CopyPicture thành Target.CopyPicture , xlBitmap thì những đoạn IF sau đó trở nên vô nghĩa

Ví dụ:
a> PicType = IIf(IsClipboardFormatAvailable(CF_BITMAP) <> 0, CF_BITMAP, CF_ENHMETAFILE) sẽ luôn cho kết quả = CF_BITMAP
b> If PicType = CF_BITMAP Then sẽ luôn = TRUE
vân... vân...

- Vậy ta nên cho thêm 1 đối số vào hàm trên để người dùng tự quyết định CopyPictue theo kiểu xlBitmap hoặc xlPicture
Hàm được sửa lại như sau:

Mã:

Function PictureFromObject(ByVal Target As Object, [COLOR=#ff0000][B]Optional ByVal bType As Boolean = True[/B][/COLOR]) As IPictureDisp
  Dim hPtr As Long, hCopy As Long, PicType As Long
  Const CF_BITMAP = 2
  Const CF_PALETTE = 9
  Const CF_ENHMETAFILE = 14
  Const IMAGE_BITMAP = 0
  Const LR_COPYRETURNORG = &H4
  Const PicType_BITMAP = 1
  Const PicType_ENHMETAFILE = 4
  Target.CopyPicture , [B][COLOR=#ff0000]IIf(bType, xlBitmap, xlPicture)[/COLOR][/B]
  PicType = IIf(IsClipboardFormatAvailable(CF_BITMAP) <> 0, CF_BITMAP, CF_ENHMETAFILE)
  If IsClipboardFormatAvailable(PicType) <> 0 Then
    If OpenClipboard(0) > 0 Then
      hPtr = GetClipboardData(PicType)
      If PicType = CF_BITMAP Then
        hCopy = CopyImage(hPtr, IMAGE_BITMAP, 0, 0, LR_COPYRETURNORG)
      Else
        hCopy = CopyEnhMetaFile(hPtr, vbNullString)
      End If
      CloseClipboard
      If hPtr <> 0 Then
        Dim uPicInfo As uPicDesc, IID_IDispatch As GUID, IPic As IPictureDisp
        With IID_IDispatch
          .Data1 = &H7BF80980
          .Data2 = &HBF32
          .Data3 = &H101A
          .Data4(0) = &H8B
          .Data4(1) = &HBB
          .Data4(2) = &H0
          .Data4(3) = &HAA
          .Data4(4) = &H0
          .Data4(5) = &H30
          .Data4(6) = &HC
          .Data4(7) = &HAB
        End With
        With uPicInfo
          .Size = Len(uPicInfo)
          .Type = IIf(PicType = CF_BITMAP, PicType_BITMAP, PicType_ENHMETAFILE)
          .hPic = hCopy
        End With
        OleCreatePictureIndirect uPicInfo, IID_IDispatch, True, IPic
        Set PictureFromObject = IPic
      End If
    End If
  End If
End Function

Code trong UserForm của viethoai được rút gọn thế này:

Mã:

Private Sub CommandButton1_Click()
  Dim IPic As IPictureDisp, shp As Shape
  On Error Resume Next
  Set shp = Sheet1.Shapes("sh1")
  If Not shp Is Nothing Then
    [COLOR=#ff0000][B]Set IPic = PictureFromObject(shp)[/B][/COLOR]
    Me.CommandButton1.Picture = IPic
  Else
    MsgBox "Không tìm thay shape nào!"
  End If
End Sub

Load Shape lên UserForm trong 2 trường hợp:
Set IPic = PictureFromObject(shp)
hoặc
Set IPic = PictureFromObject(shp, FALSE)
Rồi so sánh kết quả nhìn thấy trên CommandButton (có khác biệt)

viehoai · 10/12/12

ndu96081631 đã viết:
Load Shape lên UserForm trong 2 trường hợp:
Set IPic = PictureFromObject(shp)
hoặc
Set IPic = PictureFromObject(shp, FALSE)
Rồi so sánh kết quả nhìn thấy trên CommandButton (có khác biệt)

Em vẫn chưa thấy sự khác biệt. Xin sư phụ nói rõ hơn

Thực sự với code trên em chưa hiểu nổi, phải nghiên cứu tiếp thôi
Em cảm ơn rất nhiều

Load Shape của Sheet lên Button của Form (1 người xem)

Người dùng đang xem chủ đề này

Thành viên gắn bó

File đính kèm

Huyền thoại GPE

File đính kèm

Thành viên gắn bó

Huyền thoại GPE

File đính kèm

Thành viên gắn bó

File đính kèm

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Huyền thoại GPE

File đính kèm

Thành viên gắn bó

Huyền thoại GPE

File đính kèm

Huyền thoại GPE

File đính kèm

Thành viên gắn bó

Thành viên gắn bó

Huyền thoại GPE

File đính kèm

Thành viên gắn bó

Đếm ngược thời gian