Új hozzászólás Aktív témák

  • Fferi50
    Topikgazda

    Sziasztok!

    Biztosan már fáradt vagyok... de nem jövök rá, hogyan tudom ezt meghívni Sub-ból.
    Kérem, hogy nézzen rá valaki.

    Köszi
    P.

    Function ControlsResizeColumns(LBox As MSForms.Control, Optional ResizeListbox As Boolean)
     Application.ScreenUpdating = False
        Dim ws As Worksheet
        If sheetExists("ListboxColumnWidth", ThisWorkbook) = False Then
            Set ws = ThisWorkbook.Worksheets.Add
            ws.Name = "ListboxColumnwidth"
        Else
            Set ws = ThisWorkbook.Worksheets("ListboxColumnwidth")
            ws.Cells.Clear
        End If
        '---Listbox/Combobox to range-----
        Dim rng As Range
        Set rng = ThisWorkbook.Sheets("ListboxColumnwidth").Range("A1")
        Set rng = rng.Resize(UBound(LBox.List) + 1, LBox.ColumnCount)
        rng = LBox.List
        rng.Characters.Font.Name = formStaffList.listboxStaff.Font.Name
        rng.Characters.Font.Size = formStaffList.listboxStaff.Font.Size
        rng.Columns.AutoFit
        
        '---Get ColumnWidths------
        rng.Columns.AutoFit
        Dim sWidth As String
        Dim vR() As Variant
        Dim n As Integer
        Dim cell As Range
        For Each cell In rng.Resize(1)
            n = n + 1
            ReDim Preserve vR(1 To n)
            vR(n) = cell.EntireColumn.Width + 10 'if not some extra space it cuts a bit off the tail
        Next cell
        sWidth = Join(vR, ";")
        Debug.Print sWidth

        '---assign ColumnWidths----
        With LBox
            .ColumnWidths = sWidth
            '.RowSource = "A1:A3"
            .BorderStyle = fmBorderStyleSingle
        End With

        
        '----Optionaly Resize Listbox/Combobox--------
        If ResizeListbox = True Then
            Dim w As Long
            For i = LBound(vR) To UBound(vR)
                w = w + vR(i)
            Next
            DoEvents
            LBox.Width = w + 10
        End If
            
        'remove worksheet
        Application.DisplayAlerts = False
        ws.Delete
        Application.DisplayAlerts = True
        
        Application.ScreenUpdating = True
    End Function

    Function sheetExists(sheetToFind As String, Optional InWorkbook As Workbook) As Boolean
        If InWorkbook Is Nothing Then Set InWorkbook = ThisWorkbook
        On Error Resume Next
        sheetExists = Not InWorkbook.Sheets(sheetToFind) Is Nothing
    End Function

    Szia!
    Az első paraméter kötelező, egy userform combo vagy listbox objektum a kód alapján. A második paraméter opcionális logikai.
    Az első paraméternél meg kell adnod az objektum teljes nevét, pl. Userform1.Combobox1 (a nálad érvényes nevekkel).
    A második paraméter elhagyható, illetve False esetén nem méretezi át az objektumot, True esetén átméretezi. False és True helyett természetesen bármely általad bevezetett logikai változót alkalmazhatsz amelyiknek megfelelő az értéke számodra.
    Mivel nincs visszatérési értéke, így szerintem egyszerűen meghívható zárójelek nélkül, mint egy paraméterezett eljárás:
    ControlsResizeColumns Userform1.Combobox1,True
    Üdv.

Új hozzászólás Aktív témák