MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    Ajuda Ribbon com as chamadas das funções

    Compartilhe

    carloshmfernandes
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 35
    Registrado : 13/08/2013

    Ajuda Ribbon com as chamadas das funções

    Mensagem  carloshmfernandes em Sex 20 Dez 2013, 12:44

    Fiquei olhando o aplicativo maestro e tentei fazer a visualização dela por código vba.
    Na depuração vejo que foi encontrado a tabela tblRibbons e carregada, mas ela simplesmente não aparece na guia, utilizando a Tabela USysRibbons ela é carregada normalmente.

    Código:
    <customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui"
    loadImage="fncLoadImage">
      <ribbon startFromScratch="true">
    <tabs>
    <!-- *** GUIA PRINCIPAL ***-->
    <tab id="GuiaPrincipal" label="Principal" visible="true">
    <!-- *** Grupo Clientes ***-->
            <group id="grpClientes" label="Clientes">
               <menu id="MenuCliente" label="Abrir" imageMso ="AddOrRemoveAttendees" itemSize="large" size="large" >
                       <button id="NovoCliente"
                       label="Novo Cliente"
                       onAction="Menu.NovoCliente"
                       imageMso="AddOrRemoveAttendees"
                       description="Adicione ou edite os dados do cliente."/>
                      <button id="ListarClientes"
                       label="Listar Clientes"
                       onAction="Menu.ListarClientes"
                       image="report_user.png"
                       description="Exibe a lista de todos os clientes, com resumo de campos de fácil acesso."/>
                </menu>
     </group>

    <!-- *** Grupo Fornecedores ***-->

    <group id="grpFornecedores" label="Fornecedores">
          <menu id="MenuFornecedores" label="Abrir" image ="Fornecedores.png" itemSize="large" size="large" >
            <button id="NovoFornecedor" label="Novo Fornecedor" image="Fornecedores.png" onAction="Menu.NovoFornecedor" description="Adicione ou edite um Fornecedor."/>
            <button id="ListarFornecedores" label="Listar Fornecedores" image="Fornecedores_list.png" onAction="Menu.ListaFornecedores" description="Lista todos os fornecedores."/>
          </menu>
    </group>

    <!-- *** Grupo Transportadoras ***-->
    <group id="grpTransportadoras" label="Transportadoras">
          <menu id="MenuTransportadores" label="Abrir" image ="lorry.png" itemSize="large" size="large" >
            <button id="NovoTransportador" label="Novo/Editar" image="lorry_add.png" onAction="Menu.NovaTransportadora" description="Adicione ou edite uma Transportadorar."/>
    <button id="ListarTransportadoras" label="Listar Transportadoras" image="lorry_list.png" onAction="Menu.ListarTransportadoras" description="Liste todas as Transportadoras."/>
          </menu>
    </group>


    <!-- *** Grupo Pedidos e Compras ***-->

    <group id="grpPedidos" label="Pedidos e Compras">
        <splitButton id="cmdNovoPedido" size="large" >
          <menu id="MenuPedidos" image ="package_go.png" itemSize="large" >
             <button id="NovoPedido" label="Novo Pedido" onAction="Menu.NovoPedido" image="package_go.png" description="Adicione um novo pedido de cliente emitindo comprovante de entrega e faça a vinculação da Nfe."/>

             <button id="NovoPedidoBalcao" label="Novo Pedido Balcão" onAction="Menu.NovoPedidoBalcao" image="balcao.png" description="Adicione um pedido efetuado na loja sem emissão de nota e registro do cliente."/>

             <button id="ListadePedidos" label="Listar Pedidos" onAction="Menu.ListarPedidos" image="package_go_list.png" description="Lista todos os pedidos fechados."/>
           </menu>
         </splitButton>

        <splitButton id="cmdNovaCompras" size="large" >
          <menu id="MenuCompras" image ="package_add.png" itemSize="large" >
             <button id="NovoCompra" label="Nova Compra" onAction="Menu.NovaCompra" image="package_add.png" supertip="Adicione ou edite uma compra."/>
    <button id="ListadeCompras" label="Listar Compras" onAction="Menu.ListarCompras" image="package_add_list.png" supertip="Lista todas as compras recebidas e adicionadas ao estoque."/>
           </menu>
         </splitButton>
     </group>

    <!-- *** Grupo Estoque ***-->

    <group id="grpEstoque" label="Controle do Estoque">
        <splitButton id="cmdEstoque" size="large" >
          <menu id="MenuEstoque" image ="package.png" itemSize="large" >
             <button id="NovoProduto" label="Novo Produto" onAction="Menu.NovoProduto" image="NovoProduto.png" supertip="Adicionar novo produto ao estoque."/>
             <button id="ListaEstoque" label="Lista de Estoque" onAction="Menu.ListaEstoque" image="package_estoque.png" supertip="Listar todos os produtos do estoque."/>
          </menu>
        </splitButton>
     </group>

    <!-- *** Grupo Relatorios ***-->
    <group id="grpRelatoriosGraficos" label="Relatórios e Gráficos">
       <menu id="MenuRelatorios" label="Relatórios" imageMso ="ViewsReportView" itemSize="large" size="large">
              <button id="Cmd10MaioresPedidos"
                  label="10 Maiores Pedidos"
                  imageMso ="ViewsReportView"
                  description="Exibe os dez maiores pedidos."
                  onAction="Menu.DezMaioresPedidos"/>

            <button id="RelatoriosFinanceiros"
                 label="Relatórios Financeiro"
                 imageMso="ViewsReportView"
                 onAction="Menu.RelatoriosFinanceiros"
                 description="Utilize o formulário para filtrar e gerar os Relatórios Financeiros - Mensal, Trismestral e Anual."/>

            <button id="RelatoriosVendas"
                 label="Relatórios de Vendas"
                 imageMso="ViewsReportView"
                 onAction="Menu.RelatoriosVendas"
                 description="Utilize o formulário para filtrar e gerar os Relatórios de Vendas - Mensal, Trismestral e Anual."/>
       </menu>
       <menu id="MenuGrafico" label="Gráficos" imageMso ="ChartInsert" itemSize="large" size="large">
             <button id="GraficoFinanceiro"
                 label="Gráfico Financeiro"
                 image="money_dollar.png"
                 onAction="Menu.GraficoFinanceiro"
                 description="Abra o gráfico e visualize suas receitas e despesas, efetuando filtros anuais, mensais e trimestrais."/>
        </menu>


    </group>

    <!-- *** Grupo Configurações ***-->
    <group id="grpConfiguracaoBackup" label="Configurações e Backup">
       <menu id="MenuConfiguracao" image="configuracao.png" label="Configuração" itemSize="large" size="large">
                             <button id="CmdEmitente" image="configuracao.png"
                               label="Configurações do Emitente"
                               onAction="Menu.ConfigEmitente"
                               description="Dados da Empresa."/>
                             <button id="CmdUsuarios" imageMso="DatabasePermissionsMenu"
                               label="Usuários do Sistema."
                               onAction="Menu.ConfigUsuarios"
                               description="Usuários e Privilégios"/>
       </menu>
       <menu id="MenuDb"  label="Banco de Dados" imageMso="FileCompactAndRepairDatabase" itemSize="large" size="large">
               <button id="CmdBackupDb"
                    label="Fazer Backup do Banco de Dados"
                    imageMso="FileBackupDatabase"
                    onAction="Menu.BackupDb"
                    description="Faça backup do banco de dados regularmente  para evitar a perda de dados importantes" />
               <button idMso="FileCompactAndRepairDatabase"
                    label="Compactar e Reparar"
                    imageMso="FileCompactAndRepairDatabase" />


       </menu>
     </group>

          </tab>
        </tabs>
      </ribbon>
    </customUI>

    Adicionei isso ao código xml
    onLoad="fncRibbon">

    também adicionei getVisible="fncGetVisible"

    Meu código mo módulo Ribbon está assim
    Código:
    Option Compare Database
    Dim attAnexo As Attachment
    Public objRibbon As IRibbonUI

    Public Sub fncRibbon(ribbon As IRibbonUI)
    On Error Resume Next
    '--------------------------------------------------------------------
    'objRibbon servirá para realizarmos alterações
    'na ribbon em tempo de execução.  Permite usarmos o método INVALIDATE
    '--------------------------------------------------------------------
    Set objRibbon = ribbon
    End Sub

    Sub fncLoadImage(imageId As String, ByRef Image)
    Dim strCaminho As String
    'Verifica se o formulário fmImagensRibbons está aberto
    If Not CurrentProject.AllForms("FormUSysRibbonImages").IsLoaded Then
        'Abre formulário para somente leitura e oculto
        DoCmd.OpenForm "FormUSysRibbonImages", acNormal, , , acFormReadOnly, acHidden
        'Passa para variável attanexo o campo imagens do formulário
        Set attAnexo = Forms("FormUSysRibbonImages").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
        'Informa local e nome da imagem PNG ou ICO, extraída da tabela tblImagensRibbons
        strCaminho = fncExtrairImagem(imageId)
        'Transforma imagem PNG ou ICO em BMP e passa para a ribbon
        Set Image = LoadImage(strCaminho)
        'Deleta arquivo PNG ou ICO da pasta temporária Temp
        Kill strCaminho
    Else
        'Carrega imagens JPG, BMP ou GIF
        Set Image = attAnexo.PictureDisp(imageId)
    End If
    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("USysRibbonImages")
    Set rsFilho = rsPai.Fields("Imagens").value
    Set fld = rsFilho.Fields("filedata")
    Set fld2 = rsFilho.Fields("Filename")

    If Len(Dir(strCaminho, vbDirectory + vbHidden) & "") = 0 Then
        FileSystem.MkDir (strCaminho)
        FileSystem.SetAttr strCaminho, vbHidden
    End If

    Do While Not rsFilho.EOF
        If fld2.value = strNomeImagem Then
            fld.SaveToFile (strCaminho)
            Exit Do
        End If
        rsFilho.MoveNext
    Loop
    Set fld2 = Nothing
    Set fld = Nothing
    Set rsFilho = Nothing
    Set rsPai = Nothing
    fncExtrairImagem = strCaminho & "\" & strNomeImagem
    End Function

    Function fncCarregaRibbon()
    Dim rsRib As DAO.Recordset
    On Error GoTo trataerro
    '-----------------------------------------------------------------
    'Esta função carrega as ribbons armazenadas na tabela tblRibbons,
    'que deve ser chamada pela macro autoexec
    '
    'Crie a macro autoexec, selecione a ação EXECUTARCÓDIGO
    'e escreva o nome da função no argumento: fncCarregaRibbon()
    '------------------------------------------------------------------
    Set rsRib = CurrentDb.OpenRecordset("tblRibbons", dbOpenDynaset)
    Do While Not rsRib.EOF
      Application.LoadCustomUI rsRib!RibbonName, rsRib!RibbonXml
      rsRib.MoveNext
    Loop
    rsRib.Close
    Set rsRib = Nothing

    sair:
      Exit Function
    trataerro:
      Select Case Err.Number
        Case 3078
          MsgBox "Tabela não encontrada...", vbInformation, "Aviso"
        Case Else
          MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, _
          vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
      End Select
      Resume sair:
    End Function

    Public Sub fncGetVisible(control As IRibbonControl, ByRef visible)
    Dim j As Byte
    On Error GoTo trataerro
    'If nlogoff = False Then Exit Sub

    Select Case control.ID
        Case "GuiaPrincipal"
            visible = True
        Case Else
            visible = True ' Not Nz(fncBloquear(CLng(IIf(control.Tag = "", 0, control.Tag)), LOGIN.ID), True)
    End Select

    sair:
        Exit Sub
    trataerro:
        MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
        Resume sair:
    End Sub

    carloshmfernandes
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 35
    Registrado : 13/08/2013

    Re: Ajuda Ribbon com as chamadas das funções

    Mensagem  carloshmfernandes em Sex 20 Dez 2013, 13:31

    Moderadores podem excluir o post.
    Estava tentando chamar a função para carregar a ribon depois do login, mas tem que ser feito antes no autoexec.

    Abraços.

    carloshmfernandes
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 35
    Registrado : 13/08/2013

    Re: Ajuda Ribbon com as chamadas das funções

    Mensagem  carloshmfernandes em Sab 21 Dez 2013, 12:05

    Gostaria que fosse reaberto esse meu post.

    Estou encontrando o seguindo problema na função fncGetVisible.
    Quando é aberto o aplicativo simplesmente não é efetuado a leitura de todos os controles, apenas se efetuar o logoff e efetuo o login novamente é que ele passa pelo meu controle.
    O mais engraçado é que se deixar o valor startFromScratch="true" ele passa pelo controle grpConfiguracaoBackup

    Agora enquanto estou fazendo teste na aplicação e quero ter todas a ribbons do access 2007 deixando startFromScratch="false" ele simplesmente não passa pelo controle grpConfiguracaoBackup

    Onde tenho isso na função
    Public Sub fncGetVisible(control As IRibbonControl, ByRef visible)
    On Error GoTo trataerro
    If Logado = False Then Exit Sub

    Select Case control.ID
       Case "grpConfiguracaoBackup"
           visible = IIf(getGrupoUsuarioAtual = "Administradores", True, False) 'IIf(TipoUsuario = True, True, False)
       Case "GuiaPrincipal"
           visible = True
       Case Else
           visible = True
    End Select

    sair:
       Exit Sub
    trataerro:
       MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
       Resume sair:
    End Sub

      Data/hora atual: Sex 09 Dez 2016, 11:32