domenica 21 settembre 2014

Denominazione di ranges con le liste dei nomi.

Devo riorganizzare un po' la questione della denominazione dei ranges.
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 Function
chiamata 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