Usando Access

<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
onLoad="fncRibbon" loadImage="fncLoadImage">

...
<button
id = "bt1"                         
label = "Feed"
image="feed.png"
size="large"
onAction = "fncOnAction"
/>
...

</customUI>

Public Sub fncLoadImage(imageId As String, ByRef Image)
Dim caminho As String
caminho = CurrentProject.Path & "\imagens\"
    If InStr(imageId, ".png") > 0 Or InStr(imageId, ".ico") > 0 Then
        Set Image = LoadImage(caminho & imageId)
    Else
        Set Image = LoadPicture(caminho & imageId)
    End If
End Sub

Option Compare Database
Dim attAnexo As Attachment

'----------------------------------------------------------------------------

Public Sub fncLoadImage(imageId As String, ByRef Image)
Dim strCaminho As String

'Verifica se o formulário fmImgRibbons está aberto.
If Not CurrentProject.AllForms("frmImgRibbons").IsLoaded Then
    'Abre formulário para somente leitura e oculto.
    DoCmd.OpenForm "frmImgRibbons", acNormal, , , acFormReadOnly, acHidden
    'Passa para variável attAnexo o campo tipo anexo do formulário.
    Set attAnexo = Forms("frmImgRibbons").Controls("Imagens")
End If

'Carrega imagens JPG, BMP ou GIF

'PictureDisp extrai a imagem do campo tipo anexo do formulário.
Set Image = attAnexo.PictureDisp(imageId)

End Sub

Public Function fncExtrairImagem(strNomeImagem As String) As String
Dim strCaminho As String
Dim rsPai As DAO.Recordset
Dim rsFilho As DAO.Recordset2
Dim fld As Field2
Dim fld2 As Field2

strCaminho = CurrentProject.Path & "\temp"

Set rsPai = CurrentDb.OpenRecordset("tblImagensRibbons")
Set rsFilho = rsPai.Fields("imagemRibbon").Value
Set fld = rsFilho.Fields("filedata")
Set fld2 = rsFilho.Fields("Filename")

'Verifica se a pasta temporária temp existe. Se não existir cria a pasta

'e coloca no modo oculto.
If Len(Dir(strCaminho, vbDirectory + vbHidden) & "") = 0 Then
    FileSystem.MkDir (strCaminho)
    FileSystem.SetAttr strCaminho, vbHidden
End If

'Faz um loop procurando pela imagem.
Do While Not rsFilho.EOF
    If fld2.Value = strNomeImagem Then

        'Salva a imagem do campo tipo anexo para a pasta temporária.
        fld.SaveToFile (strCaminho)
        Exit Do
    End If
    rsFilho.MoveNext
Loop
Set fld2 = Nothing
Set fld = Nothing
Set rsFilho = Nothing
Set rsPai = Nothing

'A função retorna com o caminho e o nome do arquivo salvo, que será

'entregue à função LoadImage
fncExtrairImagem = strCaminho & "\" & strNomeImagem

End Function

Option Compare Database
Dim attAnexo As Attachment

'-----------------------------------------------------------------------

Sub fncLoadImage(imageId As String, ByRef Image)
Dim strCaminho As String

'Verifica se o formulário fmImgRibbons está aberto.
If Not CurrentProject.AllForms("frmImgRibbons").IsLoaded Then
    'Abre formulário para somente leitura e oculto.
    DoCmd.OpenForm "frmImgRibbons", acNormal, , , acFormReadOnly, acHidden
    'Passa para variável attAnexo o campo tipo anexo do formulário.
    Set attAnexo = Forms("frmImgRibbons").Controls("Imagens")
End If

'Verifica se a imagem tem extensão PNG ou ICO para aplicar a 

'função de transformação LoadImage
If InStr(imageId, ".png") > 0 Or InStr(imageId, ".ico") > 0 Then
    'Passa para a variável o local e nome da imagem PNG ou ICO, 

    'salva na pasta temporária.

    strCaminho = fncExtrairImagem(imageId)
    'Transforma imagem PNG ou ICO em BMP e passa para a ribbon.
    Set Image = LoadImage(strCaminho)
    'Deleta imagem da pasta temporária Temp
    FileSystem.Kill strCaminho
Else
    'Carrega imagens JPG, BMP ou GIF
    Set Image = attAnexo.PictureDisp(imageId)
End If
End Sub

Download

| Home | Vídeos | Tutoriais | Dicas | Ribbons | Suporte | Downloads | Contato | Artigo |