Unidad 7. Aplicaciones (IV)

Aplicación 4. Realizar varias consultas y transferir al Excel.

El siguiente caso permite extraer datos de una hoja de trabajo y los devuelve hacia otra hoja.

La siguiente imagen es una muestra del formulario que se desea crear.

Los cuadros de control a ser usados son:

Un cuadro combinado. Para mostrar la lista de los clientes y seleccionar uno.

Tres cuadros de texto. Para ver los datos que se desean almacenar

Tres cuadros de lista. Para almacenar los datos seleccionados

Los procedimientos que resuelven este problema se muestra a continuación

Dim NDat As Integer

Private Sub CboDatos_Change()

TxtDirec.Text = Cells(CboDatos.ListIndex + 2, 2)

TxtRuc.Text = Cells(CboDatos.ListIndex + 2, 3)

TxtTelef.Text = Cells(CboDatos.ListIndex + 2, 4)

LstNombre.AddItem CboDatos.List(CboDatos.ListIndex)

LstDirec.AddItem Cells(CboDatos.ListIndex + 2, 2)

LstRuc.AddItem Cells(CboDatos.ListIndex + 2, 3)

LstTelef.AddItem Cells(CboDatos.ListIndex + 2, 4)

NDat = NDat + 1

End Sub

Private Sub CmdFin_Click()

End

End Sub

Private Sub CmdInit_Click()

Sheets("Clientes").Activate

Rango = "Cliente"

NRow = Range(Rango).Count

For I = 0 To NRow - 1

CboDatos.AddItem Cells(I + 2, 1)

NDat = 0

End Sub

Private Sub Cmdstore_Click()

For I = 1 To NDat

Sheets("Lista").Cells(I + 1, 1) = LstNombre.List(I - 1)

Sheets("Lista").Cells(I + 1, 2) = LstDirec.List(I - 1)

Sheets("Lista").Cells(I + 1, 3) = LstRuc.List(I - 1)

Sheets("Lista").Cells(I + 1, 4) = LstTelef.List(I - 1)

End Sub

Para ver la solución al problema, abra el archivo Consulta con formulario.xlsm.

Noviembre-2010

Pág. 7.4