Case 9      'colonna I delle email
        If Target.Row = 2 Then
            'cella I2 per de/selezionare TUTTE le email
            'se erano già selezionate le email, le deseleziona
            s = IIf(Target.Interior.ColorIndex = 17, "o", "þ")
            For j = 3 To 1000
                If Trim(Cells(j, "H")) <> "" Then Cells(j, "I") = s
            Next
            Target.Interior.ColorIndex = IIf(s = "o", -4142, 17)
            
        Else
            'altra cella della colonna I
            'wingdings: "o" --> quadratino vuoto, "þ" --> quadratino selezionato
            'se nella cella non c'è il quadratino vuoto esce senza fare niente
            If Target <> "" Then Target = IIf(Target = "þ", "o", "þ")
        End If

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Application.Intersect(Target, Range("A:I")) Is Nothing Then Exit Sub
    If Target.Row < 2 Then Exit Sub
    If Target.Column = 9 Then
        'selezionata la cella I2
        Worksheet_BeforeDoubleClick Target, False
    End If

    If Selection.Count = 1 And Target.Row > 2 Then
        If Range("Z1") = "" Then Range("Z1") = ActiveCell.Row
        Range(Cells(ActiveCell.Row, "A"), Cells(ActiveCell.Row, "H")).Interior.ColorIndex = 36
        If [Z1] <> Target.Row Then Range(Cells([Z1], "A"), Cells([Z1], "H")).Interior.ColorIndex = 35
        Range("Z1") = Target.Row
    End If
End Sub

Option Explicit

Sub saveasPDF()
Dim LR As Long
    If MsgBox("Sei sicuro di voler stampare in pdf il registro?", vbOKCancel + vbQuestion, "STAMPA REGISTRO") = vbCancel Then Exit Sub
    Application.EnableEvents = False
    With Sheets("REGISTRO TELEFONATE")
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row
        .PageSetup.PrintArea = "A1:F" & LR
        .ExportAsFixedFormat xlTypePDF, "C:UsersSilvia&AleDesktopRegistro Telefonate"
        .Range("A3").Select
    End With
    MsgBox "Registro salvato correttamente", vbInformation + vbOKOnly, "Salva registro"
    Application.EnableEvents = True
End Sub

Sub automatic_saveasPDF()
Dim LR As Long
    Application.EnableEvents = False
     With Sheets("REGISTRO TELEFONATE")
        LR = .Cells(.Rows.Count, "A").End(xlUp).Row
        .PageSetup.PrintArea = "A1:F" & LR
        .ExportAsFixedFormat xlTypePDF, "C:UsersSilvia&AleDesktopRegistro Telefonate" & " " & "del" & " " & Format(DateAdd("d", -1, Now), "DD-MM-YYYY.pdf")
        .Range("A3:F5000").ClearContents
        .Range("A3").Select
    End With
    Sheets("ELENCO TELEFONICO").Select
    Range("A3").Select
    Application.EnableEvents = True
End Sub

Sub Fondo()
    Application.EnableEvents = False
    With Range("A3:H1117").Font
        With .Font
            .Name = "Comic Sans MS"
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .Color = -16777216
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = True
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A3").Select.Select
    Application.EnableEvents = True
End Sub
    

Sub ordina()
    Application.EnableEvents = False
    With Sheets("ELENCO TELEFONICO").Sort
        With .SortFields
            .Clear
            .Add Key:=Range("B3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .SetRange Range("A2:H1117")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
        If .FilterMode = True Then .ShowAllData
    End With
    
    Range("A3").Select
    Application.EnableEvents = True
End Sub