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

• Fferi50 Topikgazda

  #49006

  #49002 lenkei83

  2022-05-11 08:40:22

  Új Válasz

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  Fferi50

  Topikgazda

  #49002 lenkei83

  #49002 lenkei83

  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