Sección de códigos , trucos y ejemplos para visual basic

363 - Ado - Cargar menú dinámico

Ejemplo que crea un menú en forma dinámica con opciones de una base de datos usando Ado como conexión

El ejemplo necesita tener creado en tiempo de diseño, un menú oculto y con un SubMenú en una matriz, para poder crear los demás submenues en tiempo de ejecución con el método Load.

Formualrio con el menú popup cargado en tiempo de ejecución

Los parámetros que hay que pasarle a la subrutina que crea el menú popup en tiempo de ejecución con los datos de la base de datos, son tres :

Call Cargar_Menu(SubMenu, Sql, path_Bd)

SubMenu : Es el nombre del array de SubMenu.

Sql : cadena Sql para abrir el recordset que contendrá los datos para los Submenues

Path_Bd : Ruta de la base de datos

Ejemplo

1 - Crear un menú con el editor de menues de visual basic, y como nombre colocarle "MnuPopup"

2 - Dentro de este menu crear un SubMenu , y en la propiedad Index colocarle un 0 para que este forme una matriz y se puedan crear los demás

3 - Al menú principal ( el creado en el punto 1, colocarle la propiedad visible en False )

4 - Agregar la referencia a Ado desde el menú referencias ( Microsoft Activex data Objects )

5 - Agregar un módulo bas al Proyecto

Código fuente en el formulario

Option Explicit Private Sub Form_Load() Dim Sql As String Dim path_Bd As String path_Bd = "C:\Archivos de programa\Microsoft Visual Studio\VB98\nwind.mdb" Sql = "Select NombreCategoría FROM Categorías" ' llama a la sub que crea el menú _ cargando las opciones de la base de datos indicada Call Cargar_Menu(SubMenu, Sql, path_Bd) End Sub Private Sub Form_MouseDown(Button As Integer, Shift As Integer, _ X As Single, Y As Single) If Button = vbRightButton Then 'Mostramos el menu popup Me.PopupMenu MnuPopup End If End Sub Private Sub SubMenu_Click(Index As Integer) MsgBox SubMenu(Index).Caption, vbInformation End Sub

Código fuente en el módulo bas

Option Explicit ' rutina que carga el menú en tiempo de ejecucíon ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Sub Cargar_Menu(El_Menu As Object, _ Sql As String, _ path_Bd As String) On Error GoTo ErrSub ' cadena de conexión Dim Connection_String As String Dim i As Integer 'variable para la base de datos y el recordset Dim cn As ADODB.Connection Dim rst As ADODB.Recordset ' le agrega el path de la base de datos al Connectionstring Connection_String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _ path_Bd & ";Persist Security Info=False" ' Nuevo objeto Connection Set cn = New ADODB.Connection cn.CursorLocation = adUseClient 'Abre la conexión cn.Open Connection_String 'Nuevo recordset Set rst = New ADODB.Recordset ' abre el recordset rst.Open Sql, cn, adOpenStatic, adLockReadOnly 'Mueve al primer registro rst.MoveFirst 'Por si hay Submenu cargados, los descarga a todos For i = 1 To El_Menu.Count - 1 Unload El_Menu(i) Next 'Recorre los registros Do While Not rst.EOF ' Asigna el caption del primer SubMenu El_Menu(El_Menu.Count - 1).Caption = rst.Fields(0) 'Crea otro menu dinamicamente mediante Load Load El_Menu(El_Menu.Count) 'Siguiente registro rst.MoveNext Loop 'Descarga y cierra la conexión y el recordset rst.Close Set rst = Nothing cn.Close Set cn = Nothing Exit Sub 'Error ErrSub: MsgBox Err.Description, vbCritical 'Descarga y cierra la conexión y el recordset On Local Error Resume Next rst.Close Set rst = Nothing cn.Close Set cn = Nothing End Sub

Recursos vb 6.0 - Enlaces relacionados

Buscar en Recursos vb