====== Vb Grids ======

===== DataGridView ======

<code vb>
Con DataGrid1

  Dim lcStrSQL            As String
  Dim lcObjRcs            As ADODB.Recordset
  
  Set lcObjRcs = New ADODB.Recordset
  
  lcObjRcs.Fields.Append "Guia EER", adChar, 100
  lcObjRcs.Fields.Append "Codigo de Barra UPS", adDouble
  lcObjRcs.Fields.Append "DUA", adDouble
  lcObjRcs.Fields.Append "Estado", adDouble
  
  lcObjRcs.Open
  '* Add your fabricated records here...
  lcObjRcs.AddNew Array("Guia EER", "Codigo de Barra UPS", "DUA", "Estado"), Array("asd", 2, 3, 4)
  
  lcObjRcs.Update
  
  Set DataGrid1.DataSource = lcObjRcs
</code>


===== Microsoft FlexGrids =====

Componente Microsoft FlexGrid Control 6.0 (MSFLXGRD.OCX)

<code vb>

' Definiendo la cantidad de filas y columnas:
    MSFlexGrid1.Rows = 10
    MSFlexGrid1.Cols = 10
    
' Definiendo el tamaño de las columnas: 
    With Me.MSFlexGrid1
        '.CellHeight(0) = 200
        .ColWidth(0) = 300
        .ColWidth(1) = 2000
        .ColWidth(2) = 4000
        .ColWidth(3) = 1000
        .ColWidth(4) = 1000
        .ColWidth(5) = 1000
    End With
    
' Definiendo el nombre de las columnas:
    'MSFlexGrid1.Row = 0
    'MSFlexGrid1.Text = ""
    MSFlexGrid1.Col = 1
    MSFlexGrid1.Text = "Nombres"
    MSFlexGrid1.Col = 2
    MSFlexGrid1.Text = "Descripcion"
    MSFlexGrid1.Col = 3
    MSFlexGrid1.Text = "Precios"
    MSFlexGrid1.Col = 4
    MSFlexGrid1.Text = "Descuentos"
    
</code>

  * [[https://bytes.com/topic/visual-basic/answers/722706-how-change-coloumn-name-flex-grid]]

===== SGrid 2 =====

Componente vbAccelerator VB6 SGrid Control 2.0 (vbalSGrid.ocx)

  * [[http://www.vbaccelerator.com/home/index.asp]]
  * [[https://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/506-ejemplos-del-control-s-grid-de-visual-basic-accelerator.htm]]
  * [[https://10tec.com/activex-grid/vbaccelerator-sgrid.aspx]]

Documentación principal:

  * [[http://www.vbaccelerator.com/home/VB/Code/Controls/S_Grid_2/S_Grid_2/article.asp]]
  * [[http://www.vbaccelerator.com/codelib/sgrid/sgrid.htm]]

<code vb>

' Definiendo los titulos


' Codigo frmMatrixDemo de pTestSGrid

   With grdMatrix
      .Redraw = False
      .ImageList = ilsIcons
      .StretchLastColumnToFit = True
      .GridLineColor = &HC0C0C0
      .GridLines = True
      .Editable = True
      .AddColumn "tasks", , , , 8
      .AddColumn "typeid", , , , , False
      .AddColumn "articleid", , , , , False
      .DefaultRowHeight = cboArticle.Height \ Screen.TwipsPerPixelY
      
      pLoadInfo
                  
      .Redraw = True
   End With

</code>


<code vb>

    With vbalGrid1

        'Agrego y defino columnas
        .AddColumn "Guias", "Guias"
        .AddColumn "DSEER", "DSEER"
        .AddColumn "CATPCHA", "CATPCHA"
        .AddColumn "Texto", "Texto"
        .AddColumn "Canal", "Canal"
        .AddColumn "DocOrigen", "Doc Origen"
        .AddColumn "Manifiesto", "Manifiesto"

        'Defino tamaño
        .ColumnWidth(1) = 123
        .ColumnWidth(2) = 123
        .ColumnWidth(3) = 123

        '.CellText(2, 2), "asdasd"
        Dim lRow        As Long
        .Redraw = False
        Randomize
        For lRow = 1 To 100
            .AddRow
            ' -- Agregar id de producto
            Call .CellDetails(lRow, 1, CInt(Rnd * 25))
            ' -- Agregar nombres de productos
            Call .CellDetails(lRow, 2, "Producto " & CStr(lRow))
            ' -- Agregar el precio de los productos
            Call .CellDetails(lRow, 3, CDbl(Rnd * 5000))
            ' -- Agregar el precio de los productos
            Call .CellDetails(lRow, 4, CDbl(Rnd * 100))
            ' -- Agregar el Stock
            Call .CellDetails(lRow, 5, CInt(Rnd * 120))
            ' -- Agregar fecha hora
            Call .CellDetails(lRow, 6, DateAdd("d", Now, CInt(Rnd * 28)))
          
        Next
    
        .Redraw = True
    End With

</code>

[[https://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/506-ejemplos-del-control-s-grid-de-visual-basic-accelerator.htm]]

<code vb>

                Call .AddRow
                Call .CellDetails(.Rows, 1, UCase(sKey), , , RGB(0, 132, 196), vbWhite)
                Call .CellDetails(.Rows, 2, mCFindFiles.GetFileName(xFile))
                Call .CellDetails(.Rows, 3, mCFindFiles.GetFileText(xFile), DT_LEFT Or DT_MODIFYSTRING Or DT_WORDBREAK Or DT_END_ELLIPSIS, vbalImageList2.ItemIndex(sKey) - 1)
                Call .CellDetails(.Rows, 4, mCFindFiles.GetFormatSize(FileLen(xFile)))
                Call .CellDetails(.Rows, 5, mCFindFiles.GetFileType(xFile))

</code>

<code vb>

  With vbalGrid1
        Call .CellDetails(1, 1, "hola")
        'Es lo mismo
        .CellDetails 1, 2, "sd"
  End With

</code>

==== Parametros S Grid 2: ====

<code vb>

   ' -- Mostrar Lineas divisorias
   vbalGrid1.GridLines = True
   
   ' -- Selecciona toda la fila
   .RowMode = True
   
   
</code>


===== Ejemplo MsFlexGrid =====

<code vb>


Private Sub Btn_PegarExcel_Click()

 TxtClipboard = Split(Clipboard.GetText, Chr(13))
 
 MSHFlexGrid1.Rows = UBound(TxtClipboard) + 1
 
 For i = 0 To UBound(TxtClipboard) - 1
    fila = Split(TxtClipboard(i), Chr(9))
    For ii = 0 To UBound(fila)
        'MSHFlexGrid1.TextMatrix(i, ii) = fila(ii)
        If (ii < MSHFlexGrid1.Cols - 2) Then
          With MSHFlexGrid1
            MSHFlexGrid1.RowHeight(i + 1) = 300
            .Row = i + 1
            .Col = ii + 1
            .Text = Trim(Replace(fila(ii), Chr(10), ""))
            
          End With
        End If
    Next
 Next

End Sub

Private Sub Btn_CargarExcel_Click()
   Dim Ruta As String
   Dim POS, ini As Integer
   Dim Cadena As String
   Dim Archivo As String
   
   CommonDialog1.CancelError = True

On Error GoTo ErrHandler
   
   CommonDialog1.flags = cdlOFNHideReadOnly
   CommonDialog1.InitDir = App.Path
   CommonDialog1.Filter = "Archivos de Excel *.xls (*.xls)|*.xls|"
   CommonDialog1.FilterIndex = 1
   CommonDialog1.ShowOpen
   Cadena = CommonDialog1.Filename

   POS = InStr(1, Cadena, "\", vbBinaryCompare)
   While (POS <> 0)
      ini = POS + 1
      POS = InStr(ini, Cadena, "\", vbBinaryCompare)
   Wend

   'Obtiene nombre del archivo y la ruta
   Archivo = Mid(Cadena, ini, Len(Cadena))
   Ruta = Mid(Cadena, 1, ini - 1)
   POS = InStr(1, Archivo, ".", vbBinaryCompare)
   Archivo = Mid(Archivo, 1, POS - 1)
   Archivo = Mid(Archivo, 1, Len(Archivo) + 1)

   Call ImportarXls(Ruta, Archivo)
   Exit Sub

ErrHandler:
   Exit Sub    'El usuario ha hecho clic en el botón Cancelar
End Sub



Private Sub ImportarXls(ByVal parRuta As String, ByVal parArchivo As String)
   Dim fila As Long
   Dim filaxls As Integer
   Dim cant As Integer
   Dim ObjExcel As EXCEL.Application
   Dim ObjHoja As EXCEL.Worksheet
   
   Dim sql As String
   Dim col01 As String
   Dim col02 As String
   Dim col03 As String
   
On Error GoTo ControlError

   Set ObjExcel = CreateObject("excel.application")
   ObjExcel.Workbooks.Open (parRuta & parArchivo)
   Set ObjHoja = ObjExcel.Worksheets(1)

   fila = 2
   
   filaxls = 1
   
   cant = 0
   
   ObjHoja.Range("A1:C1").Activate
   
   'MSHFlexGrid1.Rows = 300
   
   Do While ObjExcel.Cells(fila, 1).Value <> ""
      
      cant = cant + 1
      col01 = UCase(ObjExcel.Cells(fila, 1).Value)    'Nro
      col02 = UCase(ObjExcel.Cells(fila, 2).Value)    'Guia
      col03 = UCase(ObjExcel.Cells(fila, 3).Value)    'DUA
      'MsgBox fila & " : " & col01 & " " & col02 & " " & col03
      'MsgBox "asdas"
        MSHFlexGrid1.Rows = filaxls + 1
        '= fila + 1
        MSHFlexGrid1.Row = filaxls
        MSHFlexGrid1.Col = 1
        MSHFlexGrid1.Text = Trim(Replace(col01, Chr(10), ""))
        MSHFlexGrid1.Col = 2
        MSHFlexGrid1.Text = Trim(Replace(col02, Chr(10), ""))
        MSHFlexGrid1.Col = 3
        MSHFlexGrid1.Text = Trim(Replace(col03, Chr(10), ""))

      
      fila = fila + 1
      filaxls = filaxls + 1
   
   Loop
   
   MsgBox "Se cargo " & cant & " registros"
   
ControlError:
   'MsgBox Err.Description
   Set ObjHoja = Nothing
   Set ObjExcel = Nothing
   On Error GoTo 0
   
End Sub

Private Sub AccionarDeMarcar()

  If chk_MarcarComoRetiroAnticipado.Value Then
    Btn_Procesar.Caption = "Procesar"
  Else
    Btn_Procesar.Caption = "Revertir Procesado"
  End If

End Sub

Private Sub Btn_Procesar_Click()
  
End Sub

Private Sub chk_MarcarComoRetiroAnticipado_Click()
  Call AccionarDeMarcar
End Sub

Private Sub Form_Load()
  
  MSHFlexGrid1.Cols = 5
  MSHFlexGrid1.RowHeight(1) = 300
  
  With MSHFlexGrid1
      '.CellHeight(0) = 200
      .ColWidth(0) = 10
      .ColWidth(1) = 1000
      .ColWidth(2) = 2000
      .ColWidth(3) = 2500
      .ColWidth(4) = 1000
      
      .Row = 0
      .Col = 1
      .Text = "Nro Orden"
      .Col = 2
      .Text = "Guia"
      .Col = 3
      .Text = "DUA"
      .Col = 4
      .Text = "Estado"
 
  End With
  
  
  
  
End Sub

Private Sub Label_MarcarComoRetiroAnticipado_Click()

  If chk_MarcarComoRetiroAnticipado.Value Then
    chk_MarcarComoRetiroAnticipado.Value = 0
  Else
    chk_MarcarComoRetiroAnticipado.Value = 1
  End If

  Call AccionarDeMarcar
  
End Sub



</code>

=====  Error en MshFlexGrid =====

solo carga 2000 filas:

Ojo error en mshflexgrid

"This bug was fixed in Service Pack 3.
  * [[http://support.microsoft.com/kb/q194653/"]]
  * [[https://www.vbforums.com/showthread.php?549433-Is-There-any-limit-for-MSHFlexGrid-s-rows#:~:text=But%20the%20MSHFlexGrid%20shows%20only%202048%20rows%20instead%20of%2015600%20rows.]]

====== Usando MSHFlexGrid =====

  * [[https://www.toolbox.com/tech/programming/question/datagridview-control-in-vb-061015/]]

<code vb>

dtatgridview1.DataSource = GetData()
..
Function GetData() As ICollection
Dim dt As DataTable, ds As DataSet
Try
ds = New DataSet()
dt = New DataTable()
dt = ds.Tables.Add(“Names”)
dt.Columns.Add(“FirstName”, GetType(String))
dt.Columns.Add(“LastName”, GetType(String))
dt.Rows.Add(“John”, “Doe”)
dt.Rows.Add(“Jane”, “Doe”)
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.Message)
End Try
Dim dv As DataView
dv = New DataView(dt)
Return dv
End Function

</code>

<code vb>

Dim ds As New DataSet
Try
ds = GetDS()
DataGridView2.DataSource = ds
DataGridView2.DataMember = ds.Tables(0).TableName
Catch ex As Exception
System.Windows.Forms.MessageBox.Show(ex.Message)
End Try
End Sub
Function GetDS() As DataSet
Dim ds As DataSet = New DataSet()
Dim dt As DataTable
Dim dr As DataRow
Try
dt = ds.Tables.Add(“Names”)
dt.Columns.Add(“FirstName”, GetType(String))
dt.Columns.Add(“LastName”, GetType(String))
dr = dt.NewRow
dr.Item(0) = “John”
dr.Item(1) = “Doe”
ds.Tables(0).Rows.Add(dr)
Catch ex As Exception
MsgBox(ex.Message.ToString())
End Try
Return ds
End Function

</code>
====== Prueba ======