Jak tisknout úkoly podle kategorie v Outlooku?

Autor: Xiaoyang Naposledy změněno: 2018-10-22

Předpokládejme, že v úkolech aplikace Outlook existují různé barevné kategorie a nyní chcete vytisknout seznamy úkolů na základě kategorií na různých stránkách. Jak byste mohli vyřešit tuto práci v Outlooku?

Tiskněte úlohy na základě kategorií na různých stránkách ručně jeden po druhém

Tiskněte úkoly založené na kategoriích na různých stránkách pomocí kódu VBA

Tiskněte úlohy na základě kategorií na různých stránkách ručně jeden po druhém

V Outlooku můžete ručně tisknout úkoly založené na různých kategoriích na různých stránkách jeden po druhém, postupujte takto:

1. Spusťte aplikaci Outlook, přejděte do podokna úloh, vyberte složku úloh, kterou chcete vytisknout, a stiskněte Ctrl + E k aktivaci Vyhledávání pole a poté pod Vyhledávání klepněte na kartu kategorizovány ikona a vyberte jednu barevnou kategorii, kterou potřebujete vytisknout, viz screenshot:

úkoly pro tisk dokumentů podle kategorie 1

2. A pak jsou všechny úkoly se specifickou kategorií barev uvedeny najednou, viz screenshot:

úkoly pro tisk dokumentů podle kategorie 2

3. Poté pokračujte kliknutím Soubor > Tisk vytisknout tento seznam úkolů, jak ukazuje následující snímek obrazovky:

úkoly pro tisk dokumentů podle kategorie 3

4. Opakujte výše uvedené kroky a ručně vytiskněte seznamy úkolů s dalšími barevnými kategoriemi.

Tiskněte úkoly založené na kategoriích na různých stránkách pomocí kódu VBA

Zde je kód VBA, který vám pomůže vytisknout úkoly založené na kategorii na různých stránkách najednou, proveďte následující kroky:

1. Přejděte na stránku Úkol v podokně a vyberte složku úloh, kterou chcete vytisknout.

2. Poté podržte ALT + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.

3. A pak klikněte Vložit > Modul, zkopírujte a vložte níže uvedený kód do otevřeného prázdného modulu:

Kód VBA: Tiskněte úkoly na základě kategorií na různých stránkách:

Sub PrintTaskList_SpecificColorCategory()
    Dim xTaskItems As Outlook.Items
    Dim xTask As Outlook.TaskItem
    Dim xDictionary As Scripting.Dictionary
    Dim xCategoryArr As Variant, xCategory As Variant
    Dim xExcelApp As Excel.Application
    Dim xExcelWorkbook As Excel.Workbook
    Dim xExcelWorksheet As Excel.Worksheet
    Dim xSheet As Excel.Worksheet
    Dim xKey As Variant
    Dim xKeyStr As String
    Dim i As Long, xLastRow As Integer
    On Error Resume Next
    If Application.ActiveExplorer.CurrentFolder.DefaultItemType <> olTaskItem Then Exit Sub
    Set xTaskItems = Application.ActiveExplorer.CurrentFolder.Items
    Set xDictionary = New Scripting.Dictionary
    For Each xTask In xTaskItems
        xCategoryArr = Split(xTask.Categories, ",")
        For Each xCategory In xCategoryArr
            If xDictionary.Exists(Trim(xCategory)) = False Then
               xDictionary.Add Trim(xCategory), 0
            End If
        Next
    Next
    If xDictionary.Count = 0 Then
        MsgBox "The current Task doesn’t have any category", vbOKOnly + vbInformation, "Kutools for Outlook"
        Exit Sub
    End If
    Set xExcelApp = New Excel.Application
    Set xExcelWorkbook = xExcelApp.Workbooks.Add
    xExcelApp.Visible = True
    i = 0
    If xDictionary.Count > xExcelWorkbook.Sheets.Count Then
        xExcelWorkbook.Sheets.Add Count:=xDictionary.Count - xExcelWorkbook.Sheets.Count
    End If
    For Each xKey In xDictionary.Keys
        xKeyStr = CStr(xKey)
        i = i + 1
        Set xExcelWorksheet = xExcelWorkbook.Sheets(i)
        xExcelWorksheet.Name = xKeyStr
        With xExcelWorksheet
             .Range("A1") = xKeyStr
             .Range("A1").Font.Bold = True
             .Range("A1").Font.Size = 18
             .Range("A1", "C1").HorizontalAlignment = xlCenter
             .Range("A1", "C1").VerticalAlignment = xlCenter
             .Range("A1", "C1").Merge
             .Range("A2") = "Subject"
             .Range("A2").Font.Bold = True
             .Range("B2") = "Start Date"
             .Range("B2").Font.Bold = True
             .Range("C2") = "Due Date"
             .Range("C2").Font.Bold = True
        End With
        For Each xTask In xTaskItems
            If InStr(xTask.Categories, xKeyStr) > 0 Then
               xLastRow = xExcelWorksheet.UsedRange.Rows.Count + 1
               With xExcelWorksheet
                    .Range("A" & xLastRow) = xTask.Subject
                    .Range("B" & xLastRow) = xTask.StartDate
                    .Range("C" & xLastRow) = xTask.DueDate
               End With
            End If
        Next
        xExcelWorksheet.Columns("A:C").AutoFit
    Next
    For Each xSheet In xExcelWorkbook.Sheets
        xSheet.PrintOut
    Next
    xExcelWorkbook.Close False
    xExcelApp.Quit
End Sub

4. Pak klikněte na tlačítko Tools > Reference v Microsoft Visual Basic pro aplikace okno, ve vyskakovacím okně Reference-Project1 v dialogovém okně zaškrtněte Objektová knihovna Microsoft Excel a Microsoft Scripting Runtime možnosti z Dostupné reference seznam, viz screenshot:

úkoly pro tisk dokumentů podle kategorie 4

5. A pak klikněte OK tlačítko, nyní stiskněte F5 klíč ke spuštění tohoto kódu, po dokončení kódu se na různých stránkách vytisknou seznamy úkolů s různými kategoriemi.