Results 1 to 21 of 21

Thread: Would like to convert Few VBA-Excel subroutines to VB.Net19

Threaded View

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    May 2021
    Posts
    172

    Would like to convert Few VBA-Excel subroutines to VB.Net19

    Hello

    Basically i wanted to convert the following VBA-Excel codes to VB.Net19
    The object in VBA excel is Listbox and unfortunately there is no listview Object in VBA Excel
    As i got stuck For viewing Each Group/Item(s) with its Selected Items/Subitems in Listview

    VBA-Excel Code
    Code:
    Option Explicit
    
    Dim lngcount As Long, iCount As Long, CurRec As Long, j As Long
    Dim Recordset As Boolean
    Dim myList As New Collection
    
    Private Sub UserForm_Initialize()
    
        Dim myarray
        Dim lstRow As Long
    
        With listBox1
            .ColumnCount = 3  
            .ListStyle = fmListStyleOption
            .MultiSelect = fmMultiSelectMulti
            .ColumnWidths = "55,70,80"  
             lstRow = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row
             myarray = Worksheets("Sheet2").Range("B3:D" & lstRow).Value   
            .List = myarray
        End With
    
        CurRec = 1
    
    
    End Sub
    
    Private Sub cmbGroup_Change()
    
        Dim myarray
        Dim lstRow As Long
        Recordset = False
        
    Dim myRanges As Range
    Set myRanges = Sheets("Sheet2").Range("B3:D10")
    
    Dim idx As Long
    
    idx = cmbGroup.ListIndex
    If idx <> -1 Then
    txtGroup.Text = Worksheets("Sheet1").Range("B" & idx + 3).Value
    
    End If
    End Sub
    
    Private Sub txtGroup_Change()
        Dim sCount As Long, lstRow As Long
        Dim rngSource
        Dim mySelections
        Dim i As Long, j As Long
    
        Recordset = False
        With Sheets("Sheet2")  'Sheets("Sheet1")
            .Activate
            'lstRow = .Cells(Rows.Count, 1).End(xlUp).Row
            lstRow = .Cells(Rows.Count, 2).End(xlUp).Row
            rngSource = .Range("B3:D" & lstRow).Value   
        End With
    
        If Not txtTrial.Text = "" Then
            For sCount = listBox1.ListCount - 1 To 0 Step -1
                If InStr(1, LCase(listBox1.List(sCount, 0)), LCase(txtTrial.Text)) = 0 Then
                    listBox1.RemoveItem sCount
                End If
            Next sCount
        Else
            listBox1.List = rngSource
        End If
    
    
    End Sub
    
    
    Private Sub cmdSelectAdd_Click()
     AppendRec True
    End Sub
    
    
    Sub AppendRec(sAdd As Boolean)
     
     Dim myItem As Collection, blnSelected As Boolean  ',icount As Long,
     Dim i As Long
     Dim noneSelectCount As Integer
     blnSelected = False
     Set myItem = New Collection
     noneSelectCount = listBox1.ListCount    'newy entered
      
     lngcount = 0
     For iCount = 0 To listBox1.ListCount - 1
         If listBox1.Selected(iCount) Then
             blnSelected = True
             myItem.Add Array(listBox1.List(iCount, 0), listBox1.List(iCount, 1), listBox1.List(iCount, 2))
             lngcount = lngcount + 1
         End If
       Next iCount
    
     
     Select Case sAdd
        Case True
            If blnSelected Then
               myList.Add myItem
             Else
               myItem.Add Array(listBox1.List(0, 0), listBox1.List(0, 1), listBox1.List(0, 2))
               myList.Add myItem
               lngcount = lngcount + 1
     End If
             List_Current_Display (CurRec)
    End Select
    
    End Sub
    
    Public Sub List_Current_Display(selItemsCount As Long)
        Dim checkItem As Long, intItem As Long
        Dim Newarray()
        Dim myItem As Collection
        Recordset = True
        listBox1.Clear
        On Local Error GoTo errlcl
    
        ReDim Preserve Newarray(1 To myList(selItemsCount).Count, 1 To 3) 
        For checkItem = 1 To myList(selItemsCount).Count
            For intItem = 1 To 3  '
                Newarray(checkItem, intItem) = myList(selItemsCount).Item(checkItem)(intItem - 1)
            Next
        Next
        
        listBox1.List = Newarray
    
    errlcl:     Resume Next
    
    End Sub
    
    Private Sub cmndNext_Click()
        If CurRec < 20 Then
           CurRec = CurRec + 1
           List_Current_Display (CurRec)
        End If
    End Sub
    Well the below is the brief Explanation of above subroutines of VBA-Excel
    1. Publicly defined variables with Option Explicit

    2. Uf_Initiliaze - Form being Loaded with Listbox

    3. ComboBox as cmbGroup to Select Group which displays its respective items in Listbox with help of TextBox_Change Event ie txtGrop_Change

    4. cmdSelectAdd_Click -> Command button to Select items calling subroutine AppendRec(True) where Each Group Entered with SELECTED List of Respective Group Items
    so basically For Eg. Group Selected is "Things" its Selected Items/Subitems could be Laptop Mobiles and Headphones out of the "Things"Full List
    Group Selected is "Fruits" its Selected Items/Subitems could be Banana and kiwi out of the "Fruits" Group List

    5. List_Current_Display(curRec) -> to display the Selected items Preserved in Array of Above Gropups "Things", "Fruits" etc ie to display Selected List of Each Group

    6. cmndNext_Click -> Command button to Display the next Current(Record) of Group with its Selected List of Items


    The below displays the Selected for One Group only as per thread 892479
    What if i had to incorporate the above VBA AppendRec(True) Subrotine in below Sub-Routine of VB.Net19. So how do i go about it ?

    VB.19 Code for SelectedItems for a Single Group
    Code:
    Private Sub CmdAddSelectedItems_Click(sender As Object, e As EventArgs) Handles CmdAddSelectedItems.Click
    
        Dim items as New List(of ListViewItem)
    
        For selItemsCount As Integer = 0 To ListView1.Items.Count - 1
           If ListView1.Items(selItemsCount).Checked = True Then
                  items.Add(New ListViewItem(ListView1.Items(selItemsCount).SubItems().Cast(Of ListViewItem.ListViewSubItem).Select(Function(s) s.Text).ToArray))
                    
            End If
        Next
    
        ListView1.Items.Clear
        ListView1.Items.AddRange(items.ToArray)
    End Sub
    If i could be assisted in converting Excel VBA above Coding specially List_current_Display(curRec) and AppendRec(true) to VB.Net 19.

    A straight forward request : Don't allow me to post replies for the Syntax Errors

    Thanks

    SamD
    Thread 11 892555
    57
    Last edited by SamDsouza; Jul 10th, 2021 at 07:22 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width