Nhờ giúp lỗi 'Method PasteFace of object _CommandBarButton failed'.

[chipvang]

Tôi dùng phương thức Pasteface để thêm custom icon vào commandbutton.
Chương trình chạy tốt nhưng khi chạy một số chương trình có can thiệp tới bộ nhớ (clipboard) thì báo lỗi 'Method PasteFace of object _CommandBarButton failed'. Có ai biết giúp gỡ hộ lỗi này.

P/s: Tôi chạy ứng dụng bình thường nhưng khi chạy teamviewer để show cho người khác xem thì thấy phát sinh lỗi trên.

...

    Set mybutton= Application.Commandbars(1).Controls.Add(Type:=msoControlButton)

    With mybutton

        .BeginGroup = BeginGroup
        .Caption = "Help me"
        .OnAction = "OnButtonClick"
                
        UserForm1.Picture1 = UserForm1.ImageList1.ListImages("Help").Picture
        Clipboard.SetData UserForm1.Picture1.Image, 2
        .PasteFace
             
    End With

...

Trong đó có cái Userform chứa cái Immage và picture để lưu và load Icon mình muốn

Lưu ý là code chạy tốt nhưng khi chạy Teamviewer thì mới báo lỗi, chắc là nó xóa bộ nhớ đệm nên phương thức Clipboard.SetData bị sai kiểu dữ liệu nên khi pasteface báo lỗi. Tôi đoán vậy nhưng chưa biết làm thế nào để tránh lỗi này.

xin các bác chỉ giúp

Thanks

 

[hai2hai]

Do anh không làm việc với Commadbar của MS Office nên không rõ về vấn đề làm ảnh trên CommandButton. CopyFace, PasteFace là hai thủ tục duy nhất có thể đưa ảnh bên ngoài vào button trên Toolbar. Bản chất làm việc của chúng là sử dụng Clipboard.

  Dim oPic As stdole.IPictureDisp
  Dim oMask As stdole.IPictureDisp

  ' Load the picture and mask.
[B][COLOR="Red"]  Set oPic = LoadPicture(App.Path & "\circle.bmp")
  Set oMask = LoadPicture(App.Path & "\mask.bmp")[/COLOR][/B]

  ' Save an instance of our application.
  Set oExcel = Application
  ' Create a new button on the standard CommandBar.
  Set oButton = oExcel.CommandBars("Standard").Controls.Add(msoControlButton)
  With oButton
    ' Set a tag for the button.
    .Tag = "My Button"
    ' Set the event to fire when the button is pressed.
    .OnAction = "!<" & AddInInst.ProgId & ">"
    ' Set the picture property -- if you are using the Mask property, this
    ' property must be set before you set the Mask property.
[B][COLOR="Red"]    .Picture = oPic[/COLOR][/B]
    ' Set the Mask property.
    .Mask = oMask
    ' Show the button.
    .Visible = True
  End With
End Sub

trích từ http://support.microsoft.com/kb/286460

How to display byte array containing the bytes of a .gif file directly to an IPictureDisp?

Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type

Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, ByVal fDeleteOnResume As Long, ByRef ppstr As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal lpStream As IUnknown, ByVal lSize As Long, ByVal fRunMode As Long, ByRef riid As GUID, ByRef lplpObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As GUID) As Long

Private Const SIPICTURE As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

Public Function PictureFromArray(ByRef b() As Byte) As IPicture
  On Error GoTo errorhandler
  
  Dim istrm As IUnknown
  Dim tGuid As GUID
  
  If Not CreateStreamOnHGlobal(b(LBound(b)), False, istrm) Then
    CLSIDFromString StrPtr(SIPICTURE), tGuid
    OleLoadPicture istrm, UBound(b) - LBound(b) + 1, False, tGuid, PictureFromArray
  End If
  
  Set istrm = Nothing
  Exit Function
errorhandler:
  Debug.Print "Could not convert to IPicture!"
End Function

Understand about IpictureDisp and BitBlt: http://www.vbforums.com/showthread.php?t=519946

P/S: LaVolpe là 1 tên tuổi trong làng VB

 

[Nguyễn Duy Tuân]

Do anh không làm việc với Commadbar của MS Office nên không rõ về vấn đề làm ảnh trên CommandButton. CopyFace, PasteFace là hai thủ tục duy nhất có thể đưa ảnh bên ngoài vào button trên Toolbar. Bản chất làm việc của chúng là sử dụng Clipboard.

Em nhầm, với CommandBarControl thì là duy nhất vì không có properties: Picture, Mask
CommandBarButton thì lại có.

  Dim oPic As stdole.IPictureDisp
  Dim oMask As stdole.IPictureDisp

  ' Load the picture and mask.
[B][COLOR="Red"]  Set oPic = LoadPicture(App.Path & "\circle.bmp")
  Set oMask = LoadPicture(App.Path & "\mask.bmp")[/COLOR][/B]

  ' Save an instance of our application.
  Set oExcel = Application
  ' Create a new button on the standard CommandBar.
  Set oButton = oExcel.CommandBars("Standard").Controls.Add(msoControlButton)
  With oButton
    ' Set a tag for the button.
    .Tag = "My Button"
    ' Set the event to fire when the button is pressed.
    .OnAction = "!<" & AddInInst.ProgId & ">"
    ' Set the picture property -- if you are using the Mask property, this
    ' property must be set before you set the Mask property.
[B][COLOR="Red"]    .Picture = oPic[/COLOR][/B]
    ' Set the Mask property.
    .Mask = oMask
    ' Show the button.
    .Visible = True
  End With
End Sub

trích từ http://support.microsoft.com/kb/286460

How to display byte array containing the bytes of a .gif file directly to an IPictureDisp?

Type GUID
  Data1 As Long
  Data2 As Integer
  Data3 As Integer
  Data4(7) As Byte
End Type

Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, ByVal fDeleteOnResume As Long, ByRef ppstr As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal lpStream As IUnknown, ByVal lSize As Long, ByVal fRunMode As Long, ByRef riid As GUID, ByRef lplpObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As GUID) As Long

Private Const SIPICTURE As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

Public Function PictureFromArray(ByRef b() As Byte) As IPicture
  On Error GoTo errorhandler
  
  Dim istrm As IUnknown
  Dim tGuid As GUID
  
  If Not CreateStreamOnHGlobal(b(LBound(b)), False, istrm) Then
    CLSIDFromString StrPtr(SIPICTURE), tGuid
    OleLoadPicture istrm, UBound(b) - LBound(b) + 1, False, tGuid, PictureFromArray
  End If
  
  Set istrm = Nothing
  Exit Function
errorhandler:
  Debug.Print "Could not convert to IPicture!"
End Function

Chỉ đúng nếu Type là msoControlButton. Cho nên khi tạo Toolbar muốn gán ảnh bởi thuộc thính Picture thì phải tạo kiểu msoControlButton.

 

[chipvang]

Cám ơn bác hai2hai và TuaVNUNI. Đề tài này xem ra có ích cho nhiều người muốn gắn Icon riêng của mình lên toolbar của thằng Off.

Vấn đề tôi nêu là lệnh các bác làm chạy tốt trông môi truờng VBA, Tôi đã thử rồi. Nhưng chạy trong môi trường VB6 thì thì báo lỗi như trên. Vì vậy tôi mới không hiểu và nhờ giúp đỡ.

Bác hai2hai có nhiều kinh nghiệm VB6 nhờ làm thử trong VB6 xem nguyên nhân sao hộ được không, dùng kỹ thuật debug dll theo bài của TuanVNUNi đó.

Cám ơn 2 bác.

 

[muontennguoikhac]

Tại sao anh lại dùng MSCOMCTRL.OCX phiên bản cũ? Và tại sao anh add control lại vào form làm gì hả Tuân? Mình làm bộ cài đặt và deliver SP tới KH cơ mà. Tại sao mọi người ko làm như vậy.

Có 46,000 người download PM bên anh rồi ko ai bị lỗi về MSCOMCTRL.OCX. Khi gặp vesion cũ trên máy của KH thì lập tức nó update luôn và khi đó PM của mình chạy ngon nghẻ. Làm sao mà bị lỗi?

Anh có nói là anh dùng phiên bản cũ đâu? Anh nói là anh dùng phiên bản mới nhất của MS, sau đó khi cài lên máy KH thì nó sẽ cài đúng y chang môi trường của máy mình lên máy của người khác và chương trình của mình sẽ chạy đúng. Vậy tại sao ko làm bộ cài đặt như thế đi?

Có lẽ anh hiểu là ý Tuân là đang dùng phiên bản cũ của OCX, sau đó cài OCX mới lên thì các forms của Tuân bị chết?

VB Project của anh làm từ 2003, anh thay mấy đời VB6 update lên rồi mà form phiệc có sao đâu nhỉ? Anh install cho bao nhiêu nơi rồi cũng có gặp vấn đề gì đâu?

Có lẽ mọi người dính với VBA nhiều quá nên cái gì cũng design time problems. Làm VB6 trơn thì hầu như ko gặp trục trặc gì về lập trình mấy.

Việc TuanVNUNI nói là có. Tôi cũng đã từng bị. Nhưng đó là chuyện xưa. Tức là nếu anh làm 1 cái ListImage từ trước năm 2003 thì sau năm đó khi mở lên sẽ thấy cái ListImage đó biến đâu mất tiêu (và hình như chỉ có ListImage mới bị lỗi thôi). Lúc đó bao nhiêu icon của tôi trong ListImage cũng đi về cõi hư vô luôn.
Còn về sau này thì anh thấy là ref nó có tên khác nhau (ví dụ như office 10, office 11 ...).
Nếu anh khai báo 1 obj thì phải khai rõ là cái thư viện nào, nếu như có 2 cái trùng tên nhau, và như vậy thi đâu có bị sai interface.
Nhưng thông thường thì ta ref chỉ chọn cái mới thôi chứ lấy cái version cũ thêm làm chi.

 

[PhanTuHuong]

Cám ơn bác hai2hai và TuaVNUNI. Đề tài này xem ra có ích cho nhiều người muốn gắn Icon riêng của mình lên toolbar của thằng Off.

Vấn đề tôi nêu là lệnh các bác làm chạy tốt trông môi truờng VBA, Tôi đã thử rồi. Nhưng chạy trong môi trường VB6 thì thì báo lỗi như trên. Vì vậy tôi mới không hiểu và nhờ giúp đỡ.

Bác hai2hai có nhiều kinh nghiệm VB6 nhờ làm thử trong VB6 xem nguyên nhân sao hộ được không, dùng kỹ thuật debug dll theo bài của TuanVNUNi đó.

Cám ơn 2 bác.

Chuyện chạy trong VBA thì tốt nhưng VB6 thì lỗi thì tôi đã từng gặp, nhiều khi cũng khó hiểu thật. Cách chuối nhất là dùng VBA phần không tương thích đó và ghép vào thôi.

 

[hai2hai]

Sorry chipvang là mình ko đụng gì tới Toolbar của MS Office. Chắc Tuân sẽ help bạn. Còn mình làm Toolbar trong VB6 đơn giản lắm , 1 cái picture và n cái button lên đó. Chả cần code kẹo gì cả

Còn về sau này thì anh thấy là ref nó có tên khác nhau (ví dụ như office 10, office 11 ...).
Nếu anh khai báo 1 obj thì phải khai rõ là cái thư viện nào, nếu như có 2 cái trùng tên nhau, và như vậy thi đâu có bị sai interface.
Nhưng thông thường thì ta ref chỉ chọn cái mới thôi chứ lấy cái version cũ thêm làm chi.

Mình cũng ko dùng gì tới ref office 10, office 11,... cả. Dùng mỗi ADO Ref thôi