Riprendiamo la routine copiaLista
Sub copiaLista()
Dim k As Integer, z As Integer
k = 1
z = 1
Do While Range("ListaNomi").Cells(k, 1) <> ""
Range("ColonnaNomiMese").Cells(z, 1).FormulaR1C1 = _
Range("ListaNomi").Cells(k, 1).FormulaR1C1
Range("ColonnaNomiMese").Cells(z, 2).FormulaR1C1 = _
Range("ListaNomi").Cells(k, 2).FormulaR1C1
k = k + 1
z = z + 1
Loop
With ActiveSheet
With .Cells(3, 6)
.Interior.ColorIndex = 6
.FormulaR1C1 = "NOME"
.HorizontalAlignment = xlCenter
End With
With .Cells(3, 8)
.Interior.ColorIndex = 8
.FormulaR1C1 = "GIORNO"
End With
With .Cells(3, 9)
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.FormulaR1C1 = "NOTTE"
End With
.Columns(6).ColumnWidth = 26
With .Columns(7)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With .Columns(8)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
End With
End Sub
La vorrei modificare nel senso che prima vengano copiate le voci dalla Lista Nomi del foglio Nascosto alla colonna 6 del foglio Calendario, procedendo soltanto dopo alla denominazione del range ListaNomiMese.
Ci provo...
Isolo la parte della routine che serve all'effettiva copiatura della lista:
Dim k As Integer, z As Integer
k = 1
z = 15
Do While Range("ListaNomi").Cells(k, 1) <> ""
Range("ColonnaNomiMese").Cells(z, 1).FormulaR1C1 = _
Range("ListaNomi").Cells(k, 1).FormulaR1C1
Range("ColonnaNomiMese").Cells(z, 2).FormulaR1C1 = _
Range("ListaNomi").Cells(k, 2).FormulaR1C1
k = k + 1
z = z + 1
Loop
E mi rendo conto che il conosco già la lunghezza della Lista Nomi, trovata per mezzo della routine NomeRangeMisurato.Quindi posso riorganizzare la cosa in modo diverso, spostando la denominazione della Lista Nomi Mese successivamente, quando questa sarà stata riempita.
Mentre cercavo di riscrivere il codice, mi sono accorto che la routine NomeRangeMisurato presentava un difetto, che ho corretto:
Function NomeRangeMisurato(rigaIniziale As Integer, colonnaIniziale As Integer, colonnaFinale As Integer, stringaLimite As String) As String
Dim k As Integer
k = rigaIniziale
Do While Cells(k, colonnaIniziale).FormulaR1C1 <> stringaLimite
k = k + 1
Loop
NomeRangeMisurato = Range(Cells(rigaIniziale, colonnaIniziale), Cells(k - 1, colonnaFinale)).Address(True, True)
End Function
In questa viene definita la colonna in cui cercare soltanto con Cells, che senza specificare il foglio mi usa le celle del foglio attivo, cosicché quando vado a misurare un range situato sul foglio nascosto mi dà un valore diverso.L'ho corretto specificando fra i parametri il foglio e usandolo prima di Cells, e il problema mi risulta ora corretto:
Function NomeRangeMisurato(rigaIniziale As Integer, colonnaIniziale As Integer, colonnaFinale As Integer, foglio As Worksheet, stringaLimite As String) As String Dim k As Integer k = rigaIniziale Do While foglio.Cells(k, colonnaIniziale).FormulaR1C1 <> stringaLimite k = k + 1 Loop NomeRangeMisurato = Range(Cells(rigaIniziale, colonnaIniziale), Cells(k - 1, colonnaFinale)).Address(True, True) End Functionchiamata con:
ActiveWorkbook.Names.Add Name:="ListaNomi", RefersTo:="=Nascosto!" & NomeRangeMisurato(1, 1, 2, Sheets("Nascosto"), "")
Corretto questo, vado a riscrivere la routine copiaLista
Dim k As Integer, z As Integer
z = 15 '(posizione iniziale della lista dei nomi del mese)
For k = 1 To Range("ListaNomi").Rows.Count
ActiveSheet.Cells(z, 6).FormulaR1C1 = Range("ListaNomi").Cells(k, 1).FormulaR1C1
z = z + 1
Next k
...che funziona egregiamente, e si basa, rispetto a quella di prima, sul fatto che conosciamo già la quantità di righe del range ListaNomi.Adesso nomino il nuovo range ListaNomiMese, di cui conosco parimenti la lunghezza.
Sub copiaLista()
Dim k As Integer, z As Integer
z = 15 '(posizione iniziale della lista dei nomi del mese)
For k = 1 To Range("ListaNomi").Rows.Count
ActiveSheet.Cells(z, 6).FormulaR1C1 = Range("ListaNomi").Cells(k, 1).FormulaR1C1
z = z + 1
Next k
ActiveWorkbook.Names.Add Name:="ListaNomiMese", RefersTo:="=" & Range(Cells(15, 6), Cells(z - 1, 9)).Address(True, True)
...e poi, selezionando questo, procedo a tutta la costruzione di una griglia e agli aspetti "estetici" (lavoro bruto)...
Range("ListaNomiMese").Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With ActiveSheet
With .Cells(Range("ListaNomiMese").Row - 1, 6)
.Interior.ColorIndex = 6
.FormulaR1C1 = "NOME"
.HorizontalAlignment = xlCenter
End With
With .Cells(Range("ListaNomiMese").Row - 1, 7)
.Interior.ColorIndex = 8
.FormulaR1C1 = "REPARTO"
End With
With .Cells(Range("ListaNomiMese").Row - 1, 8)
.Interior.ColorIndex = 8
.FormulaR1C1 = "GIORNO"
End With
With .Cells(Range("ListaNomiMese").Row - 1, 9)
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.FormulaR1C1 = "NOTTE"
End With
.Columns(6).ColumnWidth = 26
Exit Sub
With .Columns(7)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With .Columns(8)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
End With
End Sub
Nessun commento:
Posta un commento