Изменение рисунка на кнопке

[Sandr0]

Мое почтение!
Сразу скажу - 1. вопрос именно по VB, а не по VBA. 2.Постановка задачи именно такая, какая она есть, и ее треба решить (ответы типа "накой это надо" не катят).

Задача.
Есть в наличии некий файл в формате EXCEL (Book1.xls). В этом файле есть созданная панель инструментов (имя пусть будет ТемпПанель). На панели есть кнопка (хай порядковый номер будет 1). Стиль кнопки - msoButtonIconAndCaption
Есть в наличии некий файл в формате BMP. (пусть путь будет c:\11.bmp ). В нем картинка 16х16.
Необходимо средствами VB открыть Book1.xls и изменить в панели ТемпПанель рисунок кнопки с порядковым номером 1.

Вариант решения.

Код: Выделить всё

    Dim MyXLS As Object
    Dim cmBars
    Dim picPicture As IPictureDisp
   
    Name = "book1.xls"
    Set MyXLS = GetObject("c:\" & Name)
    For Each cmBars In MyXLS.Application.CommandBars
        If cmBars.Name = "ТемпПанель" Then
            With cmBars.Controls(1)
                Set picPicture = LoadPicture("c:\11.bmp")
                .Picture = picPicture
            End With
        End If
    Next


Но в строке .Picture = picPicture выскакивает ошибка: Method Picture of object _CommandBarButton failed
И я никак не въеду в чем косяк

[Павлуша]

Мне кажется, но дело в расширении. BMP он же корявый. Попробуй поменять его на JPEG или GIF. Может получится?

[Sandr0]

Эффект нетути.
причем эта конструкция работает в VBA Excel...

[alibek]

Укажи Set, думаю в этом дело.

[Sandr0]

Аналогично - Эффекту нету.

[Konst_One]

А эксель какой версии?
помниться, что там надо бмпшки только размера 16х16 вставлять в 256-цветов

[Sandr0]

Ёксель совершенно нипричем (версия 2003)
Аналогичный код с этими-же файлами в Ёкселе работает
а вот VB версии 6, хотя и с SP6.
Konst_One, я попробовал, эффекта нэт

[Konst_One]

Может:

Код: Выделить всё

Dim cmBars as Object

А еще лучше подключи в проект живые библиотеки экселя и VBA Extensibility и объяви объектные переменные явно. Вот пример , как в аутлуке бутончик на тулбаре с картинкой добавлять.

Код: Выделить всё

Public Sub AddToAddInCommandBar(sCaption As String)
    Dim cbMenu As Office.CommandBar
    On Error GoTo AddToAddInCommandBarErr

            'see if we can find the Add-Ins menu
100         Set cbMenu = OutLookInstance.ActiveExplorer.CommandBars("Tools")
110         If cbMenu Is Nothing Then
                'not available so we fail
120             GoTo lb_out
            End If
    On Error Resume Next
130         Set mcbCommandBarButton = cbMenu.Controls.Item(sCaption)
    On Error GoTo AddToAddInCommandBarErr
140         If mcbCommandBarButton Is Nothing Then
                    'add it to the command bar
150                 Set mcbCommandBarButton = cbMenu.Controls.Add(Type:=msoControlButton)
160                 With mcbCommandBarButton
                            'set the caption
170                         .Style = msoButtonIconAndCaption
180                         .Caption = sCaption
                            'copy the icon to the clipboard
190                         Clipboard.SetData LoadResPicture(101, vbResBitmap)
                            'set the icon for the button
200                         .PasteFace
210                         .Tag = sCaption
                   End With
           End If
            'see if we can find the Add-Ins toolbar
220         Set cbMenu = OutLookInstance.ActiveExplorer.CommandBars("Standard")
230         If cbMenu Is Nothing Then
                'not available so we fail
240             GoTo lb_out
            End If
On Error Resume Next
250         Set mcbToolBarButton = cbMenu.Controls.Item(sCaption)
On Error GoTo AddToAddInCommandBarErr
260         If mcbToolBarButton Is Nothing Then
                    'add it to the command bar
270                 Set mcbToolBarButton = cbMenu.Controls.Add(Type:=msoControlButton)
280                 With mcbToolBarButton
                             'set the caption
290                          .Style = msoButtonIconAndCaption
300                          .Caption = sCaption
                             'copy the icon to the clipboard
310                          Clipboard.SetData LoadResPicture(101, vbResBitmap)
                             'set the icon for the button
320                          .PasteFace
330                         .Tag = sCaption
340                         .OnAction = "!<MyAddIn.Connect>"
350                         .Visible = True
                    End With
            End If
       
lb_out:
360     Set cbMenu = Nothing
        Exit Sub
AddToAddInCommandBarErr:
370     MsgBox Err.Number & ": " & Err.Description & vbCrLf & _
               "in MyAddIn.Connect.AddToAddInCommandBar" & " Line=" & Erl, vbCritical
380         Resume Next
End Sub

[Sandr0]

Konst_One

Код: Выделить всё

Dim cmBars as Object

это не помогает
проблема в открытии файлов через OLE
Напрямую в Excel все работает
вот:

Код: Выделить всё

Option Explicit
Const sToolBars1Name = "sss"
Const sToolBars2Name = "ddd"
Sub MAINPLS2002CommandBarÂûïèñêà()
  Dim tlbr, strCommandBarName As String, strCommandBarName1 As String
  strCommandBarName1 = sToolBars1Name
  strCommandBarName = sToolBars2Name
  For Each tlbr In Toolbars
    If tlbr.Name = strCommandBarName Or tlbr.Name = strCommandBarName1 Then
      If tlbr.Name = strCommandBarName Then tlbr.Delete
    End If
  Next tlbr
With CommandBars.Add(Name:=sToolBars2Name, Position:=msoBarTop, MenuBar:=False, temporary:=False)
  .Visible = True
  Call AddButton(.Controls, "&Ïå÷àòü òåêóùåé âûïèñêè", "DÏå÷àòüÂûïèñêè", False)
End With
End Sub

Sub AddButton(ByRef mycontrol, ByVal sCaption As String, ByVal sOnAction As String, ByVal bCaption As Boolean)
  Dim strPic As String
  With mycontrol.Add(Type:=msoControlButton)
    .Caption = sCaption
    If bCaption Then
      .Style = msoButtonIconAndCaption
      Else
      .Style = msoButtonIcon
    End If
    .Picture = stdole.StdFunctions.LoadPicture("c:\11.bmp")
    .OnAction = sOnAction
  End With
End Sub


не в этом дело скорее всего

[Sandr0]

Меня смущает другое...
Если пройтись отладчиком и поставить контрольные значение на picPicture которая объявляется как IPictureDisp, то сразу после объявления она имеет тип Picture.
В свою очередь, если установить контрольное значение на cmBars.Picture мы увидим что у нее тип IPictureDisp...
Лажа кака-то ... picPicture объявляем как IPictureDisp, а тип становиться Picture... хотя cmBars.Picture четко имеет тип IPictureDisp...

[d3drm]

Уважаемый!

полагаю проблема в IPictureDisp. Попробуй напрямую загружать картинку на кнопку:

Код: Выделить всё

            With cmBars.Controls(1)
                Set .Picture = LoadPicture("c:\11.bmp")
            End With

возможно в этом вся проблема.

Удачи!

[Sandr0]

d3drm
От перемены мест слагаемых.... эффект нулевой

зы. может прежде чем писать стоит запустить VB и попробовать это сделать самому ничего личного

[d3drm]

у меня когда-то была подобная ситуация и она так решилась. возможно стоит выложить свой пример, чтобы его можно было просмотреть?

[Sandr0]

d3drm
смотри первый пост
там все описано подробно и сделать самому это не трудно

[Sandr0]

В принципе, если есть способ сделать это через API - я буду шибко рад. Кто спец по использованию API - подскажите плиз решение

[Konst_One]

я же тебе сюда кинул код, как можно обойти эту проблему через :

Код: Выделить всё

'copy the icon to the clipboard
Clipboard.SetData LoadResPicture(101, vbResBitmap)
'set the icon for the button
mcbCommandBarButton.PasteFace

вместо LoadResPicture можешь вставить LoadPicture

[Sandr0]

Konst_One
Прошу прощения за мою невнимательность!
Кажись работает. Я дома погляжу и завтра отпишусь!

[tyomitch]

BMP он же корявый.

Очень интересно. Можно поподробнее?