martedì 23 settembre 2014

Revisione della routine copiaLista del modulo formattazioneFoglio.

Una piccola revisione della routine copiaLista del modulo formattazioneFoglio: avevo dimenticato di copiare il reparto di appartenenza dei medici nella tabella ListaReparti accanto alla ListaNomiMese.
Rimedio subito:
Private 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
        ActiveSheet.Cells(z, 7).FormulaR1C1 = Range("ListaNomi").Cells(k, 2).FormulaR1C1
        z = z + 1
    Next k
    ActiveWorkbook.Names.Add Name:="ListaNomiMese", RefersTo:="=" & Range(Cells(15, 6), Cells(z - 1, 6)).Address(True, True)
    Griglia Range("ListaNomiMese")
    
    ActiveWorkbook.Names.Add Name:="ListaReparti", RefersTo:="=" & Range(Cells(15, 7), Cells(z - 1, 7)).Address(True, True)
    Griglia Range("ListaReparti")
    Range("ListaReparti").Interior.Color = RGB(100, 255, 200)

    ActiveWorkbook.Names.Add Name:="NumeriGiorni", RefersTo:="=" & Range(Cells(15, 8), Cells(z - 1, 8)).Address(True, True)
    Griglia Range("NumeriGiorni")
    Range("NumeriGiorni").Interior.Color = RGB(200, 255, 255)
    
    ActiveWorkbook.Names.Add Name:="NumeriNotti", RefersTo:="=" & Range(Cells(15, 9), Cells(z - 1, 9)).Address(True, True)
    Griglia Range("NumeriNotti")
    Range("NumeriNotti").Interior.Color = RGB(200, 100, 255)
    
    
    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