Macro per Paola

timemeter.vb

Sub TimeMeter()
'supermacro che esegue di fila le macro TIMEMETER

    TIMEMETER1
    TIMEMETER2
    TIMEMETER3
    TIMEMETER4
    TIMEMETER5

End Sub

Sub TIMEMETER1()
'
' TIMEMETER1 Macro
'

'
    'spegni "Allinea al centro"
    Cells.MergeCells = False
    Range("A1").WrapText = False
    'elimina le colonne che non servono e spegne il colore
    Range("H:J,L:N").Select
    Range("L1").Activate
    Selection.Delete Shift:=xlToLeft
    Rows("2:2").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    'Formatta come tabella
    Dim rng As Range
    Set rng = Range("A3").CurrentRegion
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = _
        "Tabella1"
    Range("Tabella1[#All]").Select
    ActiveSheet.ListObjects("Tabella1").TableStyle = "TableStyleMedium2"

End Sub


Sub TIMEMETER2()
'
' TIMEMETER2 Macro
'
    'Elimina le righe vuote
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=3, Criteria1:= _
        "="
    Range("Tabella1[Turno]").Select
    Selection.EntireRow.Delete
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=3
    
    'Elimina gli spazi dalla colonna "Eventi"
    Range("Tabella1[Eventi]").Select
    Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
        
    'Aggiunge sei colonne per contenere gli orari
    Columns("E:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    
    
    'Divide la colonna degli eventi
    Range("Tabella1[Eventi]").Select
    Selection.TextToColumns Destination:=Range("D4"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
        1)), TrailingMinusNumbers:=True
    Columns("D:I").Select
    
    'Elimina tutte le parole di troppo
    Selection.Replace What:="ENTRATA", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="USCITA", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="pausa", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="rientro", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2

    Range("Tabella1[[#Headers],[Data]]").Select
End Sub
Sub TIMEMETER3()
'
' TIMEMETER3 Macro
'

    'Aggiuge i titoli delle colonne
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Tabella1[[#Headers],[Colonna7]]").Select
    ActiveCell.FormulaR1C1 = "Settimana"
    Range("Tabella1[[#Headers],[Eventi]]").Select
    ActiveCell.FormulaR1C1 = "Entrata1"
    Range("Tabella1[[#Headers],[Colonna1]]").Select
    ActiveCell.FormulaR1C1 = "Uscita1"
    Range("Tabella1[[#Headers],[Colonna2]]").Select
    ActiveCell.FormulaR1C1 = "Entrata2"
    Range("Tabella1[[#Headers],[Colonna3]]").Select
    ActiveCell.FormulaR1C1 = "Uscita2"
    Range("Tabella1[[#Headers],[Colonna4]]").Select
    ActiveCell.FormulaR1C1 = "Entrata3"
    Range("Tabella1[[#Headers],[Colonna5]]").Select
    ActiveCell.FormulaR1C1 = "Uscita3"
    Range("Tabella1[[#Headers],[Colonna6]]").Select
    ActiveCell.FormulaR1C1 = "Fascia"
    Range("Tabella1[[#Headers],[Ore timbrate]]").Select
End Sub
    

Sub TIMEMETER4()
'
' TIMEMETER4 Macro
'

'
    'inserimento calcoli in "Settimana" e in "Giorno
    Range("Tabella1[Settimana]").Select
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=WEEKNUM(RC[-1],2)"
    Selection.NumberFormat = "0"
    Range("Tabella1[Giorno]").Select
    Application.CutCopyMode = False
    Selection.FormulaR1C1 = "=WEEKDAY(RC[-2],2)"
    ActiveWindow.SmallScroll ToRight:=6
    Range("Tabella1[Fascia]").Select
    Selection.FormulaR1C1 = "=MAX(RC[-6]:RC[-1])-MIN(RC[-6]:RC[-1])"
    ActiveWindow.SmallScroll ToRight:=2
End Sub
Sub TIMEMETER5()
'
' TIMEMETER5 Macro
'

'
    'larghezza colonne
    Range("Tabella1[[#Headers],[Data]]").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.ColumnWidth = 14
    
    'inserimento colonna "Matemat" con relativa formula
    Columns("L:L").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Tabella1[[#Headers],[Colonna1]]").Select
    ActiveCell.FormulaR1C1 = "Matemat"
    Range("L4").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "=([@Uscita1]-[@Entrata1])+([@Uscita2]-[@Entrata2])+([@Uscita3]-[@Entrata3])"
    
    'spostamento colonna "Ore pausa"
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("Q:Q").Select
    Selection.Cut
    Columns("N:N").Select
    Selection.Insert Shift:=xlToRight
    
    'rinomina colonna TOTALI e relativa formula
    Range("Tabella1[[#Headers],[Colonna1]]").Select
    ActiveCell.FormulaR1C1 = "TOTALI"
    Range("O4").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=[@[Ore timbrate]]-[@[Ore pausa]]"
    
    ' assegna il formato ore:minuti
    Range("Tabella1[[Fascia]:[TOTALI]]").Select
    Selection.Style = "Normal"
    Selection.NumberFormat = "[hh]:mm"

End Sub