Vorrei imparare a:
1) Adattare la dimensione delle colonne nella ListBox
2) Filtrare risultato tenendo conto della categoria ( in pratica se apro la userform Formazione la listbox mi fa vedere solo le righe con la categoria Formazione
[...]
3) Cliccando sul Frame1 (quello con l'immagine) aprire il collegamento ipertestuale ad un file che può avere estensioni differenti (principalmente excel, filemaker, word)
Cerco di seguire il filo delle richieste...
Nel tuo codice, l'impostazione "larghezza colonne" viene fatta con una stringa precompilata:
- Codice: Seleziona tutto
ListBox1.ColumnWidths = "50;50;50;100;150;120;60;50;50;50;50;50;50;50;50;50;50;50"
Dobbiamo sostituire questa stringa con dei valori diversi. Ho immaginato che vuoi proporzionarli a quanto sono larghe le colonne del DataBase (con la notevole considerazione che nelle celle il testo puo' andare a capo, nel listbox no)
Ho creato la stringa delle larghezze con questa seqeanza:
- Codice: Seleziona tutto
'Creazione stringa larghezza colonne:
wCoeff = 1 '<<< mah...
For I = 1 To rng.Columns.Count
wStr = wStr & ";" & Int(rng.Columns(I).Width * wCoeff)
Next I
wStr = Mid(wStr, 2)
Useremo poi wStr per impostare ColumnWidths
Se la larghezza delle colonne non e' fissa allora andranno riposizionate anche le label di intestazione, e l'ho fatto con questa sequanza:
- Codice: Seleziona tutto
'Gestione posizionamento Label del Listbox:
LabArr = Array("Label10", "Label13", "Label15") '<<< TUTTE le label, in sequenza
mySplit = Split(wStr, ";", , vbTextCompare) 'calcolo largezza di ogni colonna
PosiX = Me.ListBox1.Left 'Posizione iniziale a sx
For I = 0 To UBound(LabArr) 'Assegna posizione a ogni label
Me.Controls(LabArr(I)).Left = PosiX + 10
PosiX = PosiX + CSng(mySplit(I))
If I > UBound(mySplit) Then Exit For 'Prudenziale
Next I
Nota che l'Array LabArr non contiene TUTTE le tue label, ma non dubito che hai capito come compilarlo
Per filtrare ho usato un Array che popolo col contenuto del DB solo se la descrizione collima con quella desiderata, col seguente codice:
- Codice: Seleziona tutto
'Creazione Lista di caricamento ListBox
categ = "Formazione"
ReDim myList(1 To rng.Columns.Count, 1 To rng.Rows.Count)
For I = 1 To UBound(myList, 2)
For j = 1 To UBound(myList)
If UCase(rng.Cells(I, 2).Value) = UCase(categ) Then
If j = 1 Then myind = myind + 1
myList(j, myind) = rng.Cells(I, j)
End If
Next j
Next I
ReDim Preserve myList(1 To rng.Columns.Count, 1 To myind)
Useremo poi myList per popolare il listbox
Mettendo tutte queste cose insieme, la userform_initialize e' diventata:
- Codice: Seleziona tutto
Private Sub UserForm_Initialize()
Dim I As Long, wStr As String, wCoeff As Single
Dim LabArr, mySplit, myList(), PosiX As Single
' ListBox1.ColumnWidths = "50;50;50;100;150;120;60;50;50;50;50;50;50;50;50;50;50;50"
Dim wks1 As Worksheet
Dim uRow As Long
Dim rng As Range
Set wks1 = ThisWorkbook.Worksheets("DB")
Set rng = wks1.Range("A1").CurrentRegion
'Creazione stringa larghezza colonne:
wCoeff = 1 '<<< mah...
For I = 1 To rng.Columns.Count
wStr = wStr & ";" & Int(rng.Columns(I).Width * wCoeff)
Next I
wStr = Mid(wStr, 2)
'Gestione posizionamento Label del Listbox:
LabArr = Array("Label10", "Label13", "Label15") '<<< TUTTE le label, in sequenza
mySplit = Split(wStr, ";", , vbTextCompare) 'calcolo largezza di ogni colonna
PosiX = Me.ListBox1.Left 'Posizione iniziale a sx
For I = 0 To UBound(LabArr) 'Assegna posizione a ogni label
Me.Controls(LabArr(I)).Left = PosiX + 10
PosiX = PosiX + CSng(mySplit(I))
If I > UBound(mySplit) Then Exit For 'Prudenziale
Next I
'Creazione Lista di caricamento ListBox
categ = "Formazione"
ReDim myList(1 To rng.Columns.Count, 1 To rng.Rows.Count)
For I = 1 To UBound(myList, 2)
For j = 1 To UBound(myList)
If UCase(rng.Cells(I, 2).Value) = UCase(categ) Then
If j = 1 Then myind = myind + 1
myList(j, myind) = rng.Cells(I, j)
End If
Next j
Next I
ReDim Preserve myList(1 To rng.Columns.Count, 1 To myind)
With Me.ListBox1
.ColumnCount = rng.Columns.Count
.ColumnWidths = wStr
' .List = rng.Value
.List = Application.WorksheetFunction.Transpose(myList)
End With
Ricerca_txt.SetFocus
End Sub
Quanto all'hyperlink, il mio suggerimento e' che usi le Api di Windows per chiedere di aprire un certo file con la sua applicazione di default.
A questo scopo inserirai IN TESTA al modulo dove userai questa prestazione la seguente dichiarazione:
- Codice: Seleziona tutto
#If VBA7 Then
Private Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As LongPtr
#Else
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
#End If
Poi quando serve userai istruzioni di questo tipo:
- Codice: Seleziona tutto
ftopen =Userform1. TextBox4.Text '<<< E' un Esempio!
lngX = ShellExecute(vbNull, "Open", ftopen, "", "", vbMaximizedFocus)
Quanto alla richiesta di avere delle icone accanto (credo di aver capito) al "menu" che si apre cliccando su Form non ti so aiutare, perche' non ho le abilita' per creare "menus déroulants"; vedo che e' derivato da un lavoro di Michel Pierron ma googlando (senza dannarmi) non ho trovato nulla che mi illuminasse
Ciao
