Avrei un problema: Io ho studiato C++ a scuola in passato, ma non VB, quindi riesco a capire qualche azione che può compiere un dato programma, ma non i comandi.
Torniamo a noi, Avevo bisogno di creare un programma su excel che, alla pressione di un tasto, lui mi facesse inserire un nuovo allievo, mi creasse una nuova scheda con il nome di tale allievo (usando un modulo di scheda già impostato) e mi inserisse nella schermata principale il nome del nuovo allievo (mettendomi in ordine tutti gli altri gia esistenti/già inseriti).
Ne ho trovato uno già fatto, però ora la mia necessità è quella di avere il nome della persona inserita anche in un altro foglio ("presenze"), dove sono segnate le presenze di tutti. Avevo bisogno però che quando la nuova persona veniva inserita, il programma mi ordinasse direttamete tutte le righe in ordine alfabetico. Per farvela più breve vi incollo tutto il codice completo:
- Codice: Seleziona tutto
Public Sub mNuovoFoglio()
Dim wk As Workbook
Dim v As Variant
v = UCase(Application.InputBox("Inserire il nome del nuovo allievo."))
If v = "" Or v = False Then
MsgBox "Operazione annullata"
Exit Sub
End If
Set wk = ThisWorkbook
On Error Resume Next
With wk
.Worksheets("MODELLO").Visible = xlSheetVisible
.Worksheets("MODELLO").Copy After:=Sheets(.Sheets.Count)
ActiveSheet.Name = v
If Err.Number <> 0 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
MsgBox "Nome foglio già presente, operazione annullata."
Set wk = Nothing
Exit Sub
End If
End With
Call mOrdinaMenu
Call mOrdinaFogli(v)
ThisWorkbook.Worksheets("MODELLO").Visible = xlSheetVeryHidden
Set wk = Nothing
End Sub
Public Sub mOrdinaMenu(Optional ByVal s As Variant)
Dim shMenu As Worksheet
Dim shPresenze As Worksheet
Dim lRiga As Long
Dim lng As Long
Dim Sh As Worksheet
Dim lCont As Long
Set shMenu = ThisWorkbook.Worksheets("Menu")
Set shPresenze = ThisWorkbook.Worksheets("Presenze")
On Error Resume Next
With shMenu
Application.ScreenUpdating = False
.Select
.Range("A1").Select
.Hyperlinks.Delete
lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A2:A" & lRiga).Value = ""
lCont = 2
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> s And Sh.Name <> "MODELLO" Then
.Cells(lCont, 1).Value = Sh.Name
lCont = lCont + 1
End If
Next
.Range("A1:A" & lCont).Sort _
Key1:=Range("A2"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For lng = 2 To lCont
.Hyperlinks.Add Anchor:=.Range("A" & lng), _
Address:="", _
SubAddress:="'" & .Range("A" & lng).Value & "'!A1", _
TextToDisplay:=.Range("A" & lng).Value
Next
Application.ScreenUpdating = True
End With
On Error Resume Next
With shPresenze
Application.ScreenUpdating = False
.Select
.Range("A1").Select
.Hyperlinks.Delete
lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A2:A" & lRiga).Value = ""
lCont = 2
For Each Sh In ThisWorkbook.Worksheets
If Sh.Name <> s And Sh.Name <> "MODELLO" Then
.Cells(lCont, 1).Value = Sh.Name
lCont = lCont + 1
End If
Next
.Range("A1:A" & lCont).Sort _
Key1:=Range("A2"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
For lng = 2 To lCont
.Hyperlinks.Add Anchor:=.Range("A" & lng), _
Address:="", _
SubAddress:="'" & .Range("A" & lng).Value & "'!A1", _
TextToDisplay:=.Range("A" & lng).Value
Next
Application.ScreenUpdating = True
End With
Set shPresenze = Nothing
Set shMenu = Nothing
End Sub
Public Sub mOrdinaFogli(Optional ByVal f As String)
On Error GoTo RigaErrore
Dim NomiFogli() As String
Dim lContaFogli As Long
Dim lng As Long
Application.ScreenUpdating = False
lContaFogli = Worksheets.Count
ReDim NomiFogli(1 To lContaFogli)
For lng = 1 To lContaFogli
NomiFogli(lng) = Worksheets(lng).Name
Next
Call mOrdina(NomiFogli)
For lng = 1 To lContaFogli
Worksheets(NomiFogli(lng)).Move _
Before:=Worksheets(lng)
Next
With ThisWorkbook
.Worksheets("MENU").Move Before:=Sheets(1)
.Worksheets("MODELLO").Move Before:=Sheets(1)
If f <> "" Then
.Worksheets(f).Select
End If
End With
RigaChiusura:
Application.ScreenUpdating = True
Exit Sub
RigaErrore:
MsgBox Err.Number & vbNewLine & Err.Description
Resume RigaChiusura
End Sub
Public Sub mOrdina(ByRef sList() As String)
Dim lPrimo As Long
Dim lUltimo As Long
Dim lx As Long
Dim ly As Long
Dim sTemp As String
lPrimo = LBound(sList)
lUltimo = UBound(sList)
For lx = lPrimo To lUltimo - 1
For ly = lx + 1 To lUltimo
If sList(lx) > sList(ly) Then
sTemp = sList(ly)
sList(ly) = sList(lx)
sList(lx) = sTemp
End If
Next
Next
End Sub
Public Sub mEliminaFoglioAttivo()
Dim lRisposta As Long
lRisposta = MsgBox("Eliminare il foglio: " & _
ActiveSheet.Name & "?", vbYesNo + vbQuestion, _
"Attenzione!")
If lRisposta = vbYes Then
ActiveSheet.Delete
End If
End Sub
Grazie mille ragazzi!!
EDIT Flash: Al fine di rendere più leggibile un post contenente righe codice, è necessario l'uso del Tag "Code" che si trova nella parte superiore della finestra dell'editor