como aumentar las filas de una barra a mas de 13
Publicado por Oscar Torres (7 intervenciones) el 28/05/2017 18:35:32
Buen día,
Tengo el siguiente código para una barra, el problema que tengo es que no me acepta mas de 13 lineas, si agrego una mas me indica que la operación es compleja.
La función de la barra es la siguiente
Tengo el siguiente código para una barra, el problema que tengo es que no me acepta mas de 13 lineas, si agrego una mas me indica que la operación es compleja.
1
2
3
4
5
6
7
8
9
10
11
Private Sub Form_Load()
Dim ctl As Control
For Each ctl In Me.Controls
If ctl.ControlType = acLabel And IsNumeric(Left(ctl.Name, 2)) Then
ctl.OnClick = "=barra('" & ctl.Name & "','Colores', 'Caries', 1, 'Amalgama Adaptada', 2, 'Amalgama Desadaptada', 3, 'Exodoncia', 4, 'Ausente', 5, 'Endodoncia a Realizar', 6, 'Sin Erupcionar', 7, 'Endodoncia Realizada', 8, 'Corona Adaptada', 9, 'Corona Desadaptada', 10, 'Resina Adaptada', 11, 'Resina Desadaptada', 12, 'Sano', 13,)"
End If
Next ctl
End Sub
La función de la barra es la siguiente
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Function barra(mieti As String, nombreBarra As String, ParamArray valores() As Variant)
Dim cbar As Office.CommandBar
Dim i As Integer
Dim ctl As CommandBarControl
If (UBound(valores()) + 1) Mod 2 <> 0 Then
MsgBox "Número de parámetros incorrectos pasados a la función 'barra'" & Chr(13) & _
"Debe introducir el literal y el valor por parejas" & Chr(13) & _
"Revise la sintaxis de la funcion barra en el modulo BarraEmergente", vbInformation + vbOKOnly, "ERROR DE SINTAXIS"
Exit Function
End If
' Comprobamos si la barra existe, y si es así la borramos para poder crearla de nuevo
' es mas facil que modificarla
For Each cbar In CommandBars
If cbar.Name = nombreBarra Then
cbar.Delete
Exit For
End If
Next cbar
' Creamos la nueva barra
Set cbar = CommandBars.Add(Name:=nombreBarra, Position:=msoBarPopup, Temporary:=False)
'poniendo Temporary a False la barra es permanente. Si es False la barra se borra al cerrar la MDB
cbar.Protection = msoBarNoCustomize
' rellenamos los elementos de la barra a partir de la matriz valores()
For i = 0 To UBound(valores())
Set ctl = cbar.Controls.Add(Type:=1)
ctl.Caption = valores(i)
i = i + 1
ctl.OnAction = "= Asignavalor('" & mieti & "', '" & valores(i) & "')"
Next i
Set ctl = Nothing
Set cbar = Nothing
CommandBars(nombreBarra).ShowPopup
End Function
Valora esta pregunta


0