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 SubLa 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 LoopE 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