Cargar datos de la misma hoja de excel

[EdwinGC]

Buen día comunidad 

Antes que nada este código lo encontré en la página Mehmet Ali Gokmen y me gustaría editar el llenado del framePerson del formulario frmMain.

Para este llenado el ejemplo es tomar del mismo libro una hoja llamada BaseVentan que cuenta con 38 columnas, el framePerson me gustaría llenarlos con la columna 2, 3, 8, 10, 11, 13, 27, 28 y 29, me gustaría que se mantenga toda la visualización y ejecución del userform.

 

Dejo el código espero que me puedan ayudar y de ante mano muchas gracias.

 

'********MOUSE MOVE ICON CODES*************************************************************************************************************
#If VBA7 And Win64 Then
    ' // 64bit
    Private Declare PtrSafe Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
    Private Declare PtrSafe Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
#Else
    ' // 32bit
    Private Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
    Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long
#End If

Public WithEvents mForm             As MSForms.UserForm
Public WithEvents mPage             As MSForms.MultiPage
Public WithEvents mFrame            As MSForms.Frame
Public WithEvents actionFrame       As MSForms.Frame
Public WithEvents pageFrame         As MSForms.Frame
Public WithEvents TotalPageLabel    As MSForms.Label

Public WithEvents headerFrame       As MSForms.Frame
Public WithEvents headerLabel       As MSForms.Label

Public WithEvents tData             As MSForms.Label
Public WithEvents RowBack           As MSForms.Label
Public WithEvents ActionButton      As MSForms.Label

Public WithEvents ActionLabel        As MSForms.Label
Public WithEvents actionRowBack      As MSForms.Label

Public this                         As New clsPerson '#########
Public thisCol                      As New Collection
Public detCol                       As New Collection

Public LabelTop                     As Integer
Public LabelLeft                    As Integer
Public actionLabelTop               As Integer

Private Function MouseMoveIcon()
    Dim lngRet As Long
    lngRet = LoadCursorBynum(0&, 32649&)
    lngRet = SetCursor(lngRet)
End Function

Sub FormResize()
    On Error Resume Next
    With frmMain
        With mFrame
            .Width = frmMain.InsideWidth - mFrameWidth - 15
            .Height = frmMain.InsideHeight - .Top - 60
        End With
         With pageFrame
            .Left = mFrame.Width - pageFrame.Width - 20
            .Top = mFrame.Top + mFrame.Height + 15
         End With
         
         headerFrame.Width = mFrame.Width - 4
         actionFrame.Visible = False
         TotalPageLabel.Top = mFrame.Top + mFrame.Height + 10
         
         With frmMain.btnAddPerson '#########
            .Left = mFrame.Width - 100
            .ZOrder 0
         End With

         For i = 1 To rowCount
            With mFrame
                .Controls("ActionButton" & i).Left = mFrame.Width - 40
                .Controls("RowBack" & i).Width = mFrame.Width - 5
            End With
         Next
    End With
End Sub

Private Sub getTableData()
 
    Connect
    SQL = "Select * from tbl_Person"
    rs.Open SQL, cn, 1, 3
    rowCount = rs.RecordCount
End Sub

Function GetHeaderValue() As Variant
  headers = Array("ID", "First Name", "Last Name", "Email", "Phone", "Job", "City", "Gender", "Birth Date") '#########
                    
    GetHeaderValue = headers
End Function

Public Sub TableDataList(Optional params As String, Optional isHeader As Boolean = False)
Dim colWidth As Variant
Dim tDataTop As Variant
Dim k As Integer, i As Integer
Dim arr
Dim arr2 As Variant

Dim StartTime As Double
    Dim EndTime As Double
    Dim ElapsedTime As Double
    
    Set mForm = frmMain
    Set mPage = frmMain.MultiPage1
    Set mFrame = frmMain.framePerson '##########
    Set actionFrame = frmMain.actionFramePerson '##########
    Set pageFrame = frmMain.framePagingPerson '##########
    Set headerFrame = frmMain.frameHeaderPerson '##########
    Set TotalPageLabel = frmMain.lblTotalPagePerson '##########
    
    colWidth = Array(40, 125, 85, 140, 85, 0, 125, 85, 85, 0, 85, 85, 85, 85, 0, 0, 0, 85)
    tDataTop = Array(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
       
       getTableData
       
        With rs
            colCount = .Fields.Count
            rowCount = .RecordCount
        End With
        
          '##########HEADERS##################################################
             If isHeader = True Then
                With headerFrame
                    .Clear
                    .Caption = ""
                    .BorderStyle = fmBorderStyleSingle
                    .BorderStyle = fmBorderStyleNone
                    .ZOrder 1
                    
                    LabelLeft = 17
                    
                    For i = 0 To UBound(GetHeaderValue)
                        Set headerLabel = .Controls.Add("Forms.Label.1", "headerLabel" & i)
                            With headerLabel
                                .Caption = GetHeaderValue(i)
                                .Left = LabelLeft
                                .Top = 8
                                .Width = colWidth(i)
                                .Font.Name = "Nunito Bold"
                                .Font.Size = 11
                                .ForeColor = HeaderColor
                                .WordWrap = False
                                .BackStyle = fmBackStyleTransparent
'                                .BorderStyle = fmBorderStyleSingle
'                                .BorderColor = RGB(212, 212, 212)
                                .Tag = i
                            LabelLeft = LabelLeft + .Width + 1
                            End With
                            
                            Set this = New clsPerson '##########
                            Set this.headerLabel = headerLabel
                            thisCol.Add this
                            
                            Set headerLabel = Nothing
                            
                    Next
                .Width = LabelLeft + 15
                End With
             End If
        '##########HEADERS##################################################

        
        
       
        
         With mFrame
             .Clear
             .Caption = ""
             .Width = mPage.Width - .Left - 10
             .Height = mPage.Height - .Top - 55
             .BorderStyle = fmBorderStyleSingle
             .BorderStyle = fmBorderStyleNone
            
        
        ' // The number of lines to come is adjusted according to the frame height.
             ListRows = ListRowCount(mFrame)
             LastRecVal = PageNumber * ListRows
            
             
             If rowCount > 0 Then
                arr = rs.GetRows
                
                  '// array Transpose to arr2
                  Dim rCount As Integer
                  rCount = UBound(arr, 2)
                   ReDim arr2(LBound(arr) To UBound(arr, 2), 0 To colCount)
                    X = 0: k = 0
                         For i = LBound(arr) To UBound(arr, 2)
                         '//so that it does not give an error when the parameter is empty.
                            If params <> Empty Then
                            '//We write the column order we want instead of '2' to search
                            '//according to the order of the headers we have added.
                                If InStr(1, arr(1, i), params, vbTextCompare) <> 0 Then
                                    For Y = 0 To colCount - 1
                                        arr2(X, Y) = arr(Y, i)
                                    Next
                                    X = X + 1
                                 End If
                             Else
                                For Y = 0 To colCount - 1
                                    arr2(X, Y) = arr(Y, i)
                                Next
                                X = X + 1
                             End If
                         Next
                          
                    Erase arr
                    arr = arr2
                    Erase arr2
                    TotalRecVal = X
                    rowCount = X
                    
                    

                 LabelTop = 0
                 If arrIndex > -1 Then _
                    arr = SelectionSort(arr, arrIndex) 'when HeaderLabel click,sorting data

                 For i = FirstRecVal - 1 To LastRecVal - 1 'rowCount
                        
                        If i <= UBound(arr) Then
                            If arr(i, 0) <> Empty Then
                            
        
                             Set RowBack = .Controls.Add("Forms.Label.1", "RowBack" & i + 1)
                                 With RowBack
                                     .Width = mFrame.Width - 5
                                     .Left = 1
                                     .Height = 40
                                     .Top = LabelTop
                                     .BorderStyle = fmBorderStyleSingle
                                     .BorderColor = RGB(212, 212, 212)
                                     .BackColor = vbWhite
                                 
                                     LabelLeft = 10
                                     For k = 0 To UBound(GetHeaderValue)
                                         Set tData = mFrame.Controls.Add("Forms.Label.1", GetHeaderValue(k) & i + 1)
                                             With tData
                                                 .Width = colWidth(k)
                                                 If arr(i, k) <> Empty Then
                                                 .Caption = arr(i, k)
                                                 Else
                                                    .Caption = ""
                                                 End If
                                                 .Font.Name = "Nunito Medium"
                                                 .Font.Size = 10
                                                 .Top = LabelTop + tDataTop(k) + 12
                                                 .Height = 30
                                                 .WordWrap = True
                                                 .BackStyle = fmBackStyleTransparent
    '                                             .BorderStyle = fmBorderStyleSingle
                                                 .Left = headerFrame.Controls("headerLabel" & k).Left
                                                 .ForeColor = vbBlack 'vbGrayText
                                                  LabelLeft = LabelLeft + .Width
                                       
                                            End With
                                            
                                            Set this = New clsPerson '#########
                                            Set this.tData = tData
                                            Set this.RowBack = RowBack
                                            Set this.mFrame = mFrame
                                            Set this.actionFrame = actionFrame
                                            thisCol.Add this
                                      Next
                         
                            Set ActionButton = mFrame.Controls.Add("Forms.Label.1", "ActionButton" & i + 1)
                                  With ActionButton
                                      .Left = mFrame.Width - 40
                                      .Font.Name = "myicons"
                                      .Font.Size = 18
                                      .Caption = ChrW("&HE099")
                                      .ForeColor = vbGrayText
                                      .Top = LabelTop + 10
                                      .AutoSize = True
                                      .BackStyle = fmBackStyleTransparent
                                     .Tag = arr(i, 0) & "-" & i + 1
                                  End With
                         LabelTop = LabelTop + .Height + 3
                         
'
                         
                         
                         End With 'RowBack End
                         
                        
                         
                         Set this = New clsPerson '#########
                         Set this.ActionButton = ActionButton
                         Set this.RowBack = RowBack
                         Set this.actionFrame = actionFrame
                         Set this.mPage = mPage
                         Set this.mFrame = mFrame
                         Set this.mForm = mForm
                         thisCol.Add this
                         Set ActionButton = Nothing
                      End If
                   End If
                Next

               
                  End If
                   
    

                '##########PAGING ELEMENT###############################
                 paging.AddPageElement mFrame, pageFrame, TotalPageLabel
                '##########PAGING ELEMENT###############################
         End With
        FormResize
End Sub

'**************ACTION FRAME***********************************************************************************************
Private Sub ActionButton_Click()
Dim actionLabelIcon As MSForms.Label
Dim actionLabelCaption() As Variant
Dim ActionIcon As Variant
    
    ActionIcon = Array("0033", "E0AC")
    actionLabelCaption = Array("Edit", "Delete!")
     
    With actionFrame
         .Clear
         .Caption = ""
         .BackColor = NavFrameColor
         .BorderStyle = fmBorderStyleSingle
'         .BorderStyle = fmBorderStyleNone
         .BorderColor = NavForeColor
         .Width = 100
         .Height = 100
         .Top = ActionButton.Top + mFrame.Top - mFrame.ScrollTop
         .Left = ActionButton.Left - .Width
         .ZOrder 0
         
         actionLabelTop = 10
         
         
         For i = 1 To UBound(actionLabelCaption) + 1
         
            Set ActionLabel = .Controls.Add("Forms.Label.1", "actionLabel" & i)
                With ActionLabel
                    .Caption = actionLabelCaption(i - 1)
                    .Font.Name = "Nunito Medium"
                    .Font.Size = 11
                    .ForeColor = NavForeColor
                    .BackStyle = fmBackStyleTransparent
                    .Left = 34
                    .Top = actionLabelTop
                    .Tag = Split(ActionButton.Tag, "-")(0) & "-" & Split(ActionButton.Tag, "-")(1) & "-" & i
'                    .WordWrap = False
'                    .AutoSize = True
                    .Width = actionFrame.Width
                   
                    
                Set actionLabelIcon = .Parent.Controls.Add("Forms.Label.1", "actionLabelIcon" & ActionLabel)
                    With actionLabelIcon
                        .Font.Name = "myicons"
                        .Font.Size = 14
                        .Caption = ChrW("&H" & ActionIcon(i - 1))
                        .Left = 10
                        .Top = ActionLabel.Top
                        .ForeColor = NavForeColor
                        .BackStyle = fmBackStyleTransparent
                        .AutoSize = True
            '            .BorderStyle = fmBorderStyleSingle
                        .ZOrder 1
                    End With
            
                actionLabelTop = actionLabelTop + .Height + 14
                End With
                
                Set this = New clsPerson
                Set this.ActionLabel = ActionLabel
                Set this.actionFrame = actionFrame
                Set this.mFrame = mFrame
                detCol.Add this
                
                Set ActionLabel = Nothing
                
        Next
        
                ' // Action Label Row Back
                Set actionRowBack = .Controls.Add("Forms.Label.1", "actionRowBack")
                    With actionRowBack
                        .Height = 28
                        .Visible = False
                        .Left = 0
                        .Width = actionFrame.Width - 2
                        .BackStyle = fmBackStyleTransparent
'                        .Picture = frmElement.ActionFrameRowBack.Picture
                        .ZOrder 1
                    End With
                
        .Height = actionLabelTop
        
        If .Top + .Height > mFrame.Top + mFrame.Height Then
            .Top = ActionButton.Top + mFrame.Top - .Height - mFrame.ScrollTop + 20
        End If
        
      .Visible = True
     End With
     
     rowBackColorExit True
     RowBack.BackColor = RowBackBackColor
End Sub

Private Sub ActionButton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    MouseMoveIcon
   
End Sub

Private Sub actionFrame_Click()

End Sub

Private Sub actionLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    MouseMoveIcon
End Sub
Function GetRowValue(colIndex As Integer, rowIndex As Integer)
    head = GetHeaderValue(colIndex)
    GetRowValue = mFrame.Controls(head & rowIndex)

End Function

Private Sub ActionLabel_Click()
    Dim ActionOrder As Integer, ActionID As Integer
    Dim recOrder As Integer
    Dim accountName As String
    
    ActionID = Split(ActionLabel.Tag, "-")(0)
    recOrder = Split(ActionLabel.Tag, "-")(1)
   
    
    actionFrame.Visible = False
    Select Case ActionLabel.Caption

        Case Is = "Edit"
            Edit ActionID, recOrder
        Case Is = "Delete!"
            Delete ActionID
    End Select
    
End Sub
' headers = Array("ID", "First Name", "Last Name", "Email", "Phone", "Job", "City", "Gender","Birth Date") '#########
Sub Edit(ActionID As Integer, recOrder As Integer)
    With frmPerson
        .txtID = ActionID
        .txtFirstName = GetRowValue(1, recOrder)
        .txtLastName = GetRowValue(2, recOrder)
        .txtEmail = GetRowValue(3, recOrder)
        .txtPhone = GetRowValue(4, recOrder)
        .txtJob = GetRowValue(5, recOrder)
        .txtCity = GetRowValue(6, recOrder)
        .cbGender = GetRowValue(7, recOrder)
        .txtBirthDate = GetRowValue(8, recOrder)
        .Show
    End With
End Sub
Private Sub Delete(ActionID As Integer) '#########
    Dim answer As String
        answer = MsgBox("Person will be delete! Are you sure?", vbYesNo, "Alert Message!")
        If answer = vbYes Then
            SQL = "Delete from tbl_person where ID = " & ActionID
            cn.Execute SQL
            MsgBox "Person Deleted!"
            TableDataList frmMain.txtSearchPerson
        End If
End Sub

'**************ACTION FRAME***********************************************************************************************

Private Sub headerLabel_Click()

    arrIndex = headerLabel.Tag
        If SortDirection = "asc" Then
            SortDirection = "desc"
        ElseIf SortDirection = "desc" Then
            SortDirection = "asc"
        Else
            SortDirection = "asc"
        End If
    TableDataList
End Sub

Private Sub headerLabel_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    MouseMoveIcon
End Sub

Private Sub mForm_Click()
   rowBackColorExit
End Sub

Private Sub mFrame_Click()
    rowBackColorExit
End Sub

Private Sub mPage_Click(ByVal Index As Long)
    rowBackColorExit
End Sub

Private Sub RowBack_Click()

    rowBackColorExit
    RowBack.BackColor = RowBackBackColor
    
End Sub

Private Sub tData_Click()
    RowBack_Click
    actionFrame.Visible = False
    
End Sub

Sub rowBackColorExit(Optional actionFramevisible As Boolean = False)
    On Error Resume Next
    If actionFramevisible = False Then
        actionFrame.Visible = False
    End If
    For i = FirstRecVal To LastRecVal
        mFrame.Controls("RowBack" & i).BackColor = vbWhite
    Next
End Sub

 

 

[Antoni]

Sube tu archivo y explícate mejor.

[EdwinGC]

 Buen dia Antoni 

No me permite subir el archivo por el tamaño hay alguna otra forma de poder mandarlo para que puedan analisarlo 

 

gracias 

 

[EdwinGC]

Antonio buen día 

No pude subir el archivo ya lo intente mucho pero no se puede por el tamaño pero si me permites te dejo el link de donde descargue el proyecto, lo que requiero si me pueden ayudar

 

Es que en el Frame llamado framePerson  que en base al formulario esta conectado a una bese de access, en lugar de que se conecte a la base de datos de acces se carguen los datos de una hoja de excel del mimo libro ejemplo: la hoja se llama BaseVentas y contiene 38 columnas de las cuales me gustaría que se visualisaran en el framePerson las columnas  2, 3, 8, 10, 11, 13, 27, 28 y 29 respectiva mente y con sus respectivos formatos. 

 

Se que para el funcionamiento se tiene que mantener la conexión a access para el correcto funcionamiento por esa razón solo requiero que el único cambio sea el llenado del frame.

 

Espero haberme dado a entender ya que apenas voy iniciando en esto de la programación de antemano muchas gracias.

Dejo link de la página de YouTube del propietario del código 

 

https://youtu.be/-wWlSUcYDQM?si=NTOerTY8h8D9byXM

Saludos