Curso Software de Ventas en Visual Basic Parte 20 Inventario Borrar Exportar

Continuando con el Curso Software de Ventas en Visual Basic en este vídeo 20  Parte 20 explico como borrar un producto en la ventana de inventario, y como exportar los productos a un archivo de MS Excel.

Introducción

La finalidad de este vídeo es enseñarte como el cliente puede borrar una producto que ya a buscado con anterioridad, el cliente selecciona el producto del msGrid y luego da clic al botón Borrar este a su ves ejecuta el código que se encargada del borrado. Como medida de seguridad y para evitar borrados erróneos se le pregunta antes si esta seguro de borrar el articulo seleccionado.

En la segunda parte del vídeo te enseño como exportar todos los productos listados en el control msGrid (MSHFlexGrid), a una hoja de Microsoft Excel.

Te invito a que sigas este Curso Software de Ventas.

VÍDEO No. 20 DEL CURSO

Sub BorrarProducto()
    If msGrid.Row > 0 Then
       IdProducto = msGrid.TextMatrix(msGrid.Row, 1)
       CodProducto = msGrid.TextMatrix(msGrid.Row, 2)
       NombreProducto = msGrid.TextMatrix(msGrid.Row, 3)
       If IdProducto <> "" Then
          Res = MsgBox("¿Esta segúro de borrar el producto, " & CodProducto & " - " & NombreProducto & " ? ", vbYesNo, "Borrar Producto")
          If Res = vbYes Then
             Sql = "Delete from tblProductos Where IdProducto = " & IdProducto
             ConexionADO.Execute Sql
             Call LlenarProductosGrid
          End If
       End If
    End If
End Sub

Exportar Productos a Excel

El exportar funciona de la siguiente manera: El exportar toma los productos listados en el msGrid recorriendo fila a fila y escribiendo en cada celda del archivo de MS Excel por eso es importar tener claro que si queremos exportar todo los productos debemos listarlos todos:

Estos son los códigos para exportar Productos

'Exportar

Private Sub FlexToExcel()
    Dim XcLApp   As Object  'used for excel application'
    Dim XcLWB     As Object 'used for excel work book'
    Dim XcLWS     As Object 'used for excel work sheet'
  

    Dim I As Integer    ' counter for the rows of the flexgrid'
       
    'On Error GoTo error
    Set XcLApp = CreateObject("Excel.Application")  'creating new excel application'
    Set XcLWB = XcLApp.Workbooks.Add                'opening new excel work book'
    Set XcLWS = XcLWB.Worksheets.Add                'opening new excel worksheet'

    'taking data from flexgrid and sendting it to excel'
    XcLWS.Range(Addres_Excel(1, 1)).Value = "ID"
    XcLWS.Range(Addres_Excel(1, 2)).Value = "Código"
    XcLWS.Range(Addres_Excel(1, 3)).Value = "Nombre Artículo"
    XcLWS.Range(Addres_Excel(1, 4)).Value = "Exist"
    XcLWS.Range(Addres_Excel(1, 4)).Value = "Exis Min"
    XcLWS.Range(Addres_Excel(1, 6)).Value = "Precio Cost"
    XcLWS.Range(Addres_Excel(1, 7)).Value = "Precio V1"
    XcLWS.Range(Addres_Excel(1, 8)).Value = "Precio V2"
    XcLWS.Range(Addres_Excel(1, 9)).Value = "Precio V3"
    XcLWS.Range(Addres_Excel(1, 10)).Value = "Precio Min"
    XcLWS.Range(Addres_Excel(1, 11)).Value = "Categoria"
    XcLWS.Range(Addres_Excel(1, 12)).Value = "Proveedor"
    ProgressBar1.Visible = True
    lblprogreso.Visible = True
    If msGrid.Rows > 2 Then
       ProgressBar1.Max = msGrid.Rows - 1
    End If
    With msGrid
        For I = 1 To .Rows - 1
          For Columna = 1 To .Cols - 1
            Select Case Columna
            Case 4
                XcLWS.Range(Addres_Excel(I + 1, Columna)).Value = .TextMatrix(I, Columna)
            Case 5 To 8
                XcLWS.Range(Addres_Excel(I + 1, Columna)).Value = Format(.TextMatrix(I, Columna), "currency")
            Case Else
                XcLWS.Range(Addres_Excel(I + 1, Columna)).Value = .TextMatrix(I, Columna)
            End Select
          Next
          DoEvents
          ProgressBar1.Value = I
        Next I
    End With
    XcLApp.Visible = True
    lblprogreso.Visible = False
    ProgressBar1.Visible = False
 Exit Sub
error:
 MsgBox "ExportarExcel " & Err.Description, vbCritical, "Error al exportar"
End Sub

Public Function Addres_Excel(ByVal lng_row As Long, ByVal lng_col As Long) As String
'this function is used to send the columns from grid to excel'
'make column header to look like the letters used in excel'
'for example for col 1 the first column we will send "1" and will return "A"'

    Dim modval As Long  'used to get the reminder'
    Dim strval As String   'get the transferd letter'
    modval = (lng_col - 1) Mod 26   'using mode we get the reminder. 26 is for the letters in engl.'
    strval = Chr$(Asc("A") + modval) 'using the reminder we get the letter'
    modval = ((lng_col - 1) \ 26) - 1 'check to see if it is not addres like "AA"'
    If modval >= 0 Then strval = Chr$(Asc("A") + modval) & strval 'if we have more then we add the letter'
    Addres_Excel = strval & lng_row 'return the value to the function'
End Function

Lección Anterior Ventana de Inventario del Curso Software de Ventas Parte

Siguiente Lección  Curso Software de Ventas Parte 21, Reporte con DataReport

El código de exportar lo tome del foro de VB6Forums