Hola gente!! Les comento, estoy terminando mi BD a la cual le he puesto una Cinta "rbprincipal" y cree otra "RibbonFRMNaveG" con un "comboBox" especialmente para uno de los Form en particular.
He puesto ambas cintas en una Tabla "tblRibbons" y ambas se cargan perfectamente, pero al abrir el formulario en cuestion, todos los comandos de la cinta "RibbonFRMNaveG" responden excepto el "ComboBox" que no carga los control.id del form...Por mi escaso conomiento en esto, creira que tengo problemas en el "Callback" generado por el "gobjRibbon".
Tengo dos modulos para ambas cintas, uno que controla la cinta principal y el otro tiene los controles para el navegador.
Si alguien puede darme una mano le agradeceré muchisimo!!!
Os dejo aqui debajo ambos modulos!
Option Compare Database
Modulo "Navegador"
Private Declare Function JJJTExisteFile Lib "shlwapi.dll" Alias "PathFileExistsA" _
(ByVal pszPath As String) As Boolean
Public frmRibbon As Form
Public gobjRibbon As IRibbonUI
Public bolEnabled As Boolean
Sub CallbackOnLoad(ribbon As IRibbonUI)
Set gobjRibbon = ribbon
End Sub
Sub CallbackCBGetItemLabel(control As IRibbonControl, _
index As Integer, _
ByRef label)
Select Case control.id
Case "myComboBox"
label = DLookup("Campo", "UsysTemp", "Numero=" & index)
End Select
End Sub
Sub CreaTablaCombo()
Dim sql As String
Dim lngNr As Integer
Dim Ctl As control
JJJT_Crea_Tabla "UsysTemp", "Numero", "Campo"
For Each Ctl In frmRibbon.Controls
If TypeOf Ctl Is TextBox Or TypeOf Ctl Is ComboBox Then
lngNr = lngNr + Ctl.Controls.count
sql = "INSERT INTO UsysTemp(Numero,Campo) VALUES('" & (lngNr - 1) & "' ,'" & Ctl.Name & "')"
DoCmd.SetWarnings False
DoCmd.RunSQL sql
DoCmd.SetWarnings True
End If
Next
End Sub
Sub CallbackCBGetItemCount(control As IRibbonControl, _
ByRef count)
Select Case control.id
Case "myComboBox"
count = DCount("*", "UsysTemp")
End Select
End Sub
Sub MyComboBoxCallbackOnChange(control As IRibbonControl, _
strText As String)
Select Case control.id
Case "myComboBox"
frmRibbon(strText).SetFocus
DoCmd.RunCommand acCmdFilterMenu
End Select
End Sub
Sub CallbackCBGetText(control As IRibbonControl, _
ByRef strText)
Select Case control.id
Case "myComboBox"
strText = vbNullString
End Select
End Sub
Sub GetEnabled(control As IRibbonControl, ByRef enabled)
Select Case control.id
Case "myComboBox"
enabled = bolEnabled
gobjRibbon.InvalidateControl "myComboBox"
End Select
End Sub
Modulo "Rbprincipal"
Option Compare Database
Public objRibbon As IRibbonUI
Public Sub fncRibbon(ribbon As IRibbonUI)
On Error Resume Next
Set objRibbon = ribbon
End Sub
Public Function fncCargaRibbon()
Dim rsRib As DAO.Recordset
Dim strSQL As String
On Error GoTo trataerro
strSQL = "SELECT * FROM tblRibbons WHERE versao=1214 or versao=" & Val(Application.Version)
Set rsRib = CurrentDb.OpenRecordset(strSQL, 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 "Tabla no encontrada", vbInformation, "Aviso"
Case Else
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", _
Err.HelpFile, Err.HelpContext
End Select
Resume salir:
End Function
Public Sub fncOnAction(control As IRibbonControl)
On Error GoTo trataerro
Select Case control.id
Case "btnClose"
DoCmd.Close acForm, frmRibbon.Name
Case "btAsignaciones0000"
DoCmd.OpenForm "frmAsignados"
Case "btExpedientesMRE0000"
DoCmd.OpenForm "FPrincipal"
Case "btBuscarPorFiltroEstandar"
DoCmd.OpenForm "frmFiltro"
Case "btFiltrarProFecha"
DoCmd.OpenForm frmCapturaPorFechas
Case "btAlmanaque"
DoCmd.OpenForm "frmCalendario"
Case "btCalculadora"
Call Shell("calc.exe", vbNormalFocus)
Case "btlogoff"
Call fncLogoff
Case "btbackup"
DoCmd.OpenForm "frmBackup"
Case Else
MsgBox "Ha Clickeado en el boton " & control.id, vbInformation, "Aviso"
End Select
salir:
Exit Sub
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume salir:
End Sub
Public Sub fncGetVisible(control As IRibbonControl, ByRef visible)
On Error GoTo trataerro
If nlogoff = False Then Exit Sub
Select Case control.id
Case "grSeguridad"
If login.id = 1 Then
visible = True
Else
visible = False
End If
Case "grExpedientes"
If DLookup("bloqueada", "tblPermisosUsuarios", "idfuncion = 1 AND IdUsuario = " & login.id) = -1 Then j = j + 1
If DLookup("bloqueada", "tblPermisosUsuarios", "idfuncion = 2 AND IdUsuario = " & login.id) = -1 Then j = j + 1
If j = 2 Then
visible = False
Else
visible = True
End If
j = 0
Case "guiaPrincipal"
visible = True
Case Else
If DLookup("bloqueada", "tblPermisosUsuarios", "idfuncion = " & CLng(IIf(control.Tag = "", 0, control.Tag)) & " AND IdUsuario = " & login.id) = -1 Then
visible = False
Else
visible = True
End If
End Select
salir:
Exit Sub
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume sair:
End Sub
Public Sub fncGetEnabled(control As IRibbonControl, ByRef enabled)
On erro GoTo trataerro
If nlogoff = False Then Exit Sub
Select Case control.Tag
Case Else
If DLookup("bloqueada", "tblPermisosUsuarios", "idfuncion = " & CLng(IIf(control.Tag = "", 0, control.Tag)) & " AND IdUsuario = " & login.id) = -1 Then
enabled = False
Else
enabled = True
End If
End Select
salir:
Exit Sub
trataerro:
MsgBox "Erro: " & Err.Number & vbCrLf & Err.Description, vbCritical, "Aviso", Err.HelpFile, Err.HelpContext
Resume salir:
End Sub
|
Crear cuenta