ChatGPT 協作 Excel：寫公式、生成 VBA、自動製圖與匯出 PDF 報表

Excel 報表最容易令人誤會的兩個詞是「AI 幫你寫」和「一鍵完成」。ChatGPT 可以很快提供公式和 VBA，但它不知道你的欄位是否重複、金額是否含稅、空白列應否略過、舊圖表可否刪除、PDF 要存在哪裏，也不會替你證明輸出的數字正確。可靠流程不是由提示詞直接跳到按鈕，而是由規格、公式、程式碼、測試和驗收逐層建立。

本文把一個銷售報表案例完整拆成九步：用 Excel Table 固定資料結構；讓 ChatGPT 先重述規格；建立列級銷售額、總額、業務彙總和佔比；審查 VBA；建立直條圖，並在資料適合時建立圓餅圖；動態設定列印範圍；匯出不覆寫舊檔的 PDF；最後用數字、版面和重跑測試驗收。

封面是經人工審核的來源公開封面，畫面不含人物、作者、頻道、帳戶或社交平台身份。九張步驟圖與三段操作預覽則是根據已核對流程製作的 1280×720 重構示意，全部使用虛構資料，並在畫面和圖說標明不是來源影片截圖。

安全底線：AI 生成的 VBA 是未受信任程式碼草稿，而且 Excel 巨集不能復原，執行後亦會清除復原記錄。第一次執行前先保存並使用副本，只可放入虛構小樣本；不要在唯一一份正式報表、同步中的共享檔或未經批准的公司資料上試跑。即使錯誤處理已還原 Excel 狀態，執行中途失敗仍可能留下部分報表，因此每次都要核對結果。

先看成果：由銷售明細到可覆核 PDF 的九步路線

1. 複製來源檔，建立虛構測試資料。
2. 把資料轉成命名 Table，固定六個唯一標題。
3. 用規格提示詞讓 ChatGPT 先確認粒度、單位和空白政策。
4. 建立列級銷售額與總銷售額公式。
5. 按業務建立 SUMIFS 彙總和安全佔比。
6. 要求 VBA 明確列出讀寫範圍、錯誤處理和禁止行為。
7. 在標準 Module 編譯及小樣本執行，生成報表與圖表。
8. 設定列印範圍和一頁闊，匯出具時間戳 PDF。
9. 核對原始列、摘要、圖表、PDF 與重跑結果。

步驟一：先做副本，再固定資料合約

在碰公式或 VBA 前，先把來源檔另存測試副本。若稍後要保存巨集，使用 Microsoft 建議的 Excel Macro-Enabled Workbook（.xlsm）；不要把唯一一份 .xlsx 直接轉換後覆蓋。關閉再重開一次，確認工作表、公式和格式仍然存在。

把來源範圍選成 Excel Table，並在 Table Design／表格設計確認名稱為 tblSales。Microsoft 的結構化參照說明指出，Table 名稱和欄名會成為公式的一部分，新增或刪除資料列時參照可隨表格調整。這比硬寫 F2:F9999 容易維護，但欄名重複、拼錯或總計列仍會令結果錯。

如果真實業務有折扣、退貨、稅、匯率、取消單或跨月入帳，不要硬套本文的簡化公式。先把規則加到資料合約和驗收案例，否則 AI 只會精確地自動化錯誤口徑。

步驟二：讓 ChatGPT 先理解資料，而不是直接叫它「寫公式」

最有效的第一輪不是上傳整份工作簿，而是提供欄位、資料類型、幾列虛構樣本、規則和預期輸出。要求 AI 先重述理解，可以及早找出「銷售額是否含稅」「業務名稱空白怎樣辦」「報告包含哪個期間」等缺口。

你是 Microsoft Excel 資料分析與公式導師。請先理解規格，不要立即猜公式。

工作簿只使用虛構測試資料。
來源工作表：銷售明細
Excel 表格名稱：tblSales
欄位：日期、業務、產品、數量、單價、銷售額
資料規則：
- 日期必須是有效 Excel 日期。
- 數量必須是大於或等於 0 的數字。
- 單價與銷售額使用港元，不含稅。
- 銷售額 = 數量 × 單價。
- 空白業務、公式錯誤、文字格式數字要列作驗收失敗，不可靜默略過。

輸出要求：
1. 先重述你理解的欄位、粒度、單位和假設。
2. 給出 tblSales 的列級銷售額結構化公式。
3. 給出總銷售額公式。
4. 在「報表」工作表按 A 欄業務名稱，用 SUMIFS 計算每位業務銷售額。
5. 計算每位業務佔總銷售額比例，總額為 0 時不要出現除零錯誤。
6. 每條公式說明輸入、輸出、向下填滿方法及 3 個驗算案例。
7. 如果我的 Excel 版本、表格名稱或欄名不足以決定答案，先提問，不要自行發明。

如果 AI 回答時自行加了「地區」「成本」「稅率」等不存在欄位，先停止。不要為遷就答案而改來源表；應把缺少資訊補回規格，再重新要求只使用已確認欄位。

步驟三：建立列級銷售額公式，先驗三列再填滿

在 tblSales 的「銷售額」第一個資料格輸入：

=[@數量]*[@單價]

Table 會把同一列的數量和單價相乘，並通常自動建立計算欄向下填滿。不要只看公式有沒有填滿；抽查至少三列，包括一般數字、零數量和小數單價。本文的資料合約不接受負數；若退貨必須用負數表示，先修訂資料合約、彙總口徑、圖表政策和測試案例，才可修改公式或程式。

常見錯誤：#VALUE! 通常表示內容無法轉為數字，但某些看似數字的文字亦可能被公式自動轉換；#NAME? 可能是 Table 或欄名不一致；結果全為零可能是空白、文字零或錯誤範圍。不要用 IFERROR(...,0) 把所有問題一律藏成零，因為這會令錯誤資料進入報表。

步驟四：計算總銷售額和按業務彙總

總銷售額可在「報表」工作表使用完整 Table 欄參照：

=SUM(tblSales[銷售額])

然後在 A5:A 列出已核對的業務名稱，在 B5 用 SUMIFS 彙總並向下填滿：

=SUMIFS(tblSales[銷售額],tblSales[業務],A5)

Microsoft 特別提醒，SUMIFS 的 sum_range 是第一個參數，與 SUMIF 的參數順序不同；所有 sum_range 和 criteria_range 亦必須有相同列數和欄數。若再加日期條件，應使用開始日和「下一期第一日之前」的邊界，避免時間值漏算月底交易。

必要對數：SUM(業務小計) - SUM(tblSales[銷售額]) 必須是零。若不是，先找空白業務、前後空格、同名不同字、未列出的業務或公式範圍，而不是手動改摘要數字。

步驟五：計算佔比，但不要掩蓋零總額

在 C5 計算業務佔比，可用：

=IF(SUM(tblSales[銷售額])=0,0,B5/SUM(tblSales[銷售額]))

將格式設為百分比後向下填滿。當總額不為零、所有分類均符合既定政策時，底層比例合計應為 100%；逐項四捨五入後的畫面數字偶爾可能顯示 99.9% 或 100.1%，要用未四捨五入值驗算。若總額為零，本文選擇顯示 0%；正式報表亦可以顯示「不適用」，但必須先定義。若日後修訂合約以接受退貨負數，圓餅圖便不適合，應改用橫條圖或分開顯示正負。

公式完成後，先判斷是否真的需要 VBA

如果報表只需每月手動更新一次，Table、公式、樞紐分析表或 Power Query 可能已足夠。VBA 的價值是把多個已確定步驟串起來，例如清理專用報表範圍、重建指定圖表、套用列印設定和匯出 PDF。它不應被用來掩蓋尚未釐清的業務規則。

步驟六：用限制清楚的 Prompt 要求 VBA

不要只說「幫我一鍵做圖表和 PDF」。那句話沒有指定來源、輸出、重跑行為、覆寫政策、錯誤處理或資料外流。下面的提示詞先界定最小權限，再要求 AI 提供程式：

你是資深 Microsoft Excel VBA 工程師。請根據以下規格產生可在桌面 Excel 測試的完整程式碼。

任務：由 ThisWorkbook.Worksheets("銷售明細") 唯讀資料，重新計算並核對「數量 × 單價」，按「業務」彙總，把結果寫到程式擁有的專用工作表「報表」。固定建立直條圖；只有總額、分類數量和各分類數值適合時才建立圓餅圖。動態設定列印範圍，最後把「報表」工作表匯出成 PDF。

必要條件：
1. 使用 Option Explicit；所有變數完整宣告。
2. 驗證「日期、業務、產品、數量、單價、銷售額」六個標題只出現一次。
3. 來源工作表不可被清空、排序、改值或加入圖表。
4. 不用 ActiveWorkbook、ActiveSheet、Select、Selection 或 Activate。
5. 不用 Shell、Kill、FileSystemObject、HTTP、Outlook、外部連線、寄信、下載、登錄檔或 Workbook_Open。
6. 先在記憶體完成兩輪驗證；日期、業務、產品、數量、單價和銷售額不合規、數量 × 單價對不上、公式錯誤、超過 100,000 列或超過 50 個業務分類便停止，且在停止前不可清理舊報表。
7. 以擁有權標記識別程式建立的「報表」；遇到未標記的同名工作表或未知圖形／圖表便停止。重跑只可清理已標記的生成範圍和兩個固定名稱圖表。
8. 活頁簿未儲存為本機 .xlsm 時停止；PDF 放在活頁簿同一資料夾，檔名加入時間戳，已存在便加序號，不可覆寫或刪除檔案。
9. PDF 只匯出「報表」；按實際摘要與圖表動態設定列印範圍，使用橫向、一頁闊，OpenAfterPublish=False。
10. 錯誤時顯示 Err.Number、Err.Description 和處理階段，並以容錯方式還原 Calculation、EnableEvents、ScreenUpdating、DisplayAlerts 和 StatusBar。
11. 先列出讀寫範圍與副作用，再給完整程式碼，最後給 Windows、Mac、零銷售額、重跑和 PDF 數字核對測試。

若你未建立 Developer 索引標籤、不知道 Module 在哪裏，先閱讀 ChatGPT 寫 Excel VBA 入門。本文不重複所有安裝畫面，但執行前仍要做到：正確 VBAProject、標準 Module、完整 Sub…End Sub、Debug → Compile、另存 .xlsm、關閉再重開。巨集安全保留「停用並通知」或公司的受管設定；不要為了執行一個檔案而全域啟用所有巨集。

要做到真正「一鍵」，可在工作表插入形狀或 Form Control 按鈕，再把它指派給 BuildSalesReportAndExportPdf。Microsoft 365 和 Office 2024 預設停用 ActiveX，而且 Mac 的相容性不同，因此本文不要求 ActiveX。按鈕只改變啟動方式，不會令程式碼自動變得可信。

完整 VBA：彙總、圖表、列印範圍與不覆寫 PDF

以下範例先用兩輪記憶體驗證所有來源列，重新以數量 × 單價計算金額，再與來源「銷售額」和彙總結果獨立對數；通過後才處理報表。來源工作表不會被修改。程式以擁有權標記識別自己生成的「報表」，遇到未標記的同名工作表或未知物件便停止，以免把別人的內容當成舊輸出清理。程式已作靜態和人工安全審查，但沒有在 Excel 內編譯或執行；仍須在你的 Windows／Mac、印表機驅動和檔案權限環境，以測試副本完成驗收。

Option Explicit

Private Const SOURCE_SHEET As String = "銷售明細"
Private Const REPORT_SHEET As String = "報表"
Private Const REPORT_MARKER As String = "HKLEARN_AI_SALES_REPORT_V1"
Private Const REPORT_MARKER_CELL As String = "N1"
Private Const REPORT_ROWS_CELL As String = "N2"
Private Const SALES_CHART_NAME As String = "chtSalesByPerson"
Private Const SHARE_CHART_NAME As String = "chtSalesShare"
Private Const MAX_DATA_ROWS As Long = 100000
Private Const MAX_REPORT_CATEGORIES As Long = 50
Private Const MAX_PIE_CATEGORIES As Long = 12
Private Const MONEY_TOLERANCE As Double = 0.01

Public Sub BuildSalesReportAndExportPdf()
    Dim oldCalculation As XlCalculation
    Dim oldEvents As Boolean
    Dim oldScreenUpdating As Boolean
    Dim oldDisplayAlerts As Boolean
    Dim oldStatusBar As Variant
    Dim stateCaptured As Boolean
    Dim stage As String
    Dim failureNumber As Long
    Dim failureDescription As String
    Dim wsSource As Worksheet
    Dim wsReport As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim requiredHeaders As Variant
    Dim headerColumns As Variant
    Dim sourceValues As Variant
    Dim people() As String
    Dim totals() As Double
    Dim dataRow As Long
    Dim sheetRow As Long
    Dim validRowCount As Long
    Dim personCount As Long
    Dim personIndex As Long
    Dim personName As String
    Dim quantity As Double
    Dim unitPrice As Double
    Dim sourceAmount As Double
    Dim calculatedAmount As Double
    Dim calculatedTotal As Double
    Dim sourceTotal As Double
    Dim summaryTotal As Double
    Dim totalRow As Long
    Dim previousClearRows As Long
    Dim clearRows As Long
    Dim pieCreated As Boolean
    Dim pdfPath As String

    On Error GoTo Fail

    oldCalculation = Application.Calculation
    oldEvents = Application.EnableEvents
    oldScreenUpdating = Application.ScreenUpdating
    oldDisplayAlerts = Application.DisplayAlerts
    oldStatusBar = Application.StatusBar
    stateCaptured = True

    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.StatusBar = "正在驗證銷售資料…"

    stage = "檢查活頁簿"
    If Len(ThisWorkbook.Path) = 0 Then
        Err.Raise vbObjectError + 701, , "請先把測試活頁簿儲存為本機 .xlsm。"
    End If
    If ThisWorkbook.FileFormat <> xlOpenXMLWorkbookMacroEnabled Then
        Err.Raise vbObjectError + 702, , "測試活頁簿必須是 Excel Macro-Enabled Workbook (.xlsm)。"
    End If
    If InStr(1, ThisWorkbook.Path, "://", vbTextCompare) > 0 Then
        Err.Raise vbObjectError + 703, , "請先把活頁簿另存到已核准的本機資料夾。"
    End If

    stage = "尋找來源工作表"
    Set wsSource = GetWorksheet(ThisWorkbook, SOURCE_SHEET)
    If wsSource Is Nothing Then
        Err.Raise vbObjectError + 704, , "找不到工作表：" & SOURCE_SHEET
    End If

    stage = "驗證標題"
    lastCol = LastUsedColumn(wsSource)
    lastRow = LastUsedRow(wsSource)
    If lastRow < 2 Or lastCol = 0 Then
        Err.Raise vbObjectError + 705, , "來源工作表沒有可處理的資料列。"
    End If
    If lastRow - 1 > MAX_DATA_ROWS Then
        Err.Raise vbObjectError + 706, , "資料超過 " & Format$(MAX_DATA_ROWS, "#,##0") & " 列。"
    End If

    requiredHeaders = Array("日期", "業務", "產品", "數量", "單價", "銷售額")
    headerColumns = ResolveRequiredHeaders(wsSource, requiredHeaders, lastCol)

    stage = "重新計算來源公式"
    wsSource.Calculate

    stage = "讀取來源快照"
    sourceValues = LoadRequiredColumns(wsSource, lastRow, headerColumns)
    headerColumns = Array(1, 2, 3, 4, 5, 6)

    stage = "第一輪：驗證每一列"
    For dataRow = 1 To UBound(sourceValues, 1)
        If Not RequiredFieldsAreBlank(sourceValues, dataRow, headerColumns) Then
            sheetRow = dataRow + 1
            ValidateSourceRow sourceValues, dataRow, sheetRow, headerColumns
            validRowCount = validRowCount + 1
        End If
    Next dataRow
    If validRowCount = 0 Then
        Err.Raise vbObjectError + 707, , "沒有通過驗證的銷售資料。"
    End If

    ReDim people(1 To validRowCount)
    ReDim totals(1 To validRowCount)

    stage = "第二輪：重新計算與彙總"
    For dataRow = 1 To UBound(sourceValues, 1)
        If Not RequiredFieldsAreBlank(sourceValues, dataRow, headerColumns) Then
            personName = Trim$(CStr(sourceValues(dataRow, CLng(headerColumns(1)))))
            quantity = CDbl(sourceValues(dataRow, CLng(headerColumns(3))))
            unitPrice = CDbl(sourceValues(dataRow, CLng(headerColumns(4))))
            sourceAmount = CDbl(sourceValues(dataRow, CLng(headerColumns(5))))
            calculatedAmount = quantity * unitPrice

            personIndex = FindPersonIndex(people, personCount, personName)
            If personIndex = 0 Then
                If personCount >= MAX_REPORT_CATEGORIES Then
                    Err.Raise vbObjectError + 708, , _
                        "業務分類超過 " & MAX_REPORT_CATEGORIES & _
                        " 個；請改用樞紐分析表、Power Query 或分拆報告。"
                End If
                personCount = personCount + 1
                people(personCount) = personName
                personIndex = personCount
            End If

            totals(personIndex) = totals(personIndex) + calculatedAmount
            calculatedTotal = calculatedTotal + calculatedAmount
            sourceTotal = sourceTotal + sourceAmount
        End If
    Next dataRow

    If Abs(calculatedTotal - sourceTotal) > MONEY_TOLERANCE Then
        Err.Raise vbObjectError + 709, , _
            "來源銷售額合計與重新計算合計不一致。差額：" & _
            Format$(sourceTotal - calculatedTotal, "0.00")
    End If

    SortSummaryDescending people, totals, personCount

    stage = "驗證報表擁有權"
    Set wsReport = GetWorksheet(ThisWorkbook, REPORT_SHEET)
    If wsReport Is Nothing Then
        Set wsReport = ThisWorkbook.Worksheets.Add( _
            After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
        wsReport.Name = REPORT_SHEET
        previousClearRows = 20
    Else
        previousClearRows = ValidateOwnedReportSheet(wsReport)
    End If

    totalRow = personCount + 5
    clearRows = totalRow + 2
    If clearRows < 20 Then clearRows = 20
    If previousClearRows > clearRows Then clearRows = previousClearRows

    stage = "重建專用報表"
    DeleteKnownCharts wsReport
    wsReport.Range("A1:N" & clearRows).Clear
    WriteOwnershipMarker wsReport, clearRows
    WriteSummary wsReport, people, totals, personCount, calculatedTotal, _
                 validRowCount, totalRow

    summaryTotal = Application.WorksheetFunction.Sum( _
        wsReport.Range("B5:B" & (personCount + 4)))
    If Abs(summaryTotal - calculatedTotal) > MONEY_TOLERANCE Then
        Err.Raise vbObjectError + 710, , _
            "報表摘要與重新計算合計不一致。差額：" & _
            Format$(summaryTotal - calculatedTotal, "0.00")
    End If

    stage = "建立圖表"
    pieCreated = AddReportCharts(wsReport, totals, personCount, calculatedTotal)

    stage = "設定列印範圍"
    ConfigurePrintLayout wsReport, totalRow, pieCreated

    stage = "匯出 PDF"
    pdfPath = NextAvailablePdfPath( _
        ThisWorkbook.Path, "銷售報表_" & Format$(Now, "yyyymmdd_hhnnss"))
    wsReport.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=pdfPath, _
        Quality:=xlQualityStandard, _
        IncludeDocProperties:=False, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

    RestoreApplicationState oldCalculation, oldEvents, oldScreenUpdating, _
                            oldDisplayAlerts, oldStatusBar
    stateCaptured = False

    MsgBox "報表已完成。" & vbCrLf & _
           "有效資料列：" & validRowCount & vbCrLf & _
           "業務數：" & personCount & vbCrLf & _
           "總銷售額：" & Format$(calculatedTotal, "#,##0.00") & vbCrLf & _
           "圖表數：" & IIf(pieCreated, 2, 1) & vbCrLf & _
           "PDF：" & pdfPath, vbInformation
    Exit Sub

Fail:
    failureNumber = Err.Number
    failureDescription = Err.Description
    If stateCaptured Then
        RestoreApplicationState oldCalculation, oldEvents, oldScreenUpdating, _
                                oldDisplayAlerts, oldStatusBar
    End If
    MsgBox "報表建立失敗。" & vbCrLf & _
           "階段：" & stage & vbCrLf & _
           "錯誤 " & failureNumber & "：" & failureDescription, vbCritical
End Sub

Private Function ResolveRequiredHeaders(ByVal ws As Worksheet, _
                                        ByVal requiredHeaders As Variant, _
                                        ByVal lastCol As Long) As Variant
    Dim result() As Long
    Dim index As Long

    ReDim result(LBound(requiredHeaders) To UBound(requiredHeaders))
    For index = LBound(requiredHeaders) To UBound(requiredHeaders)
        result(index) = FindUniqueHeaderColumn( _
            ws, CStr(requiredHeaders(index)), lastCol)
        If result(index) = 0 Then
            Err.Raise vbObjectError + 726, , _
                "標題缺失或重複：" & CStr(requiredHeaders(index))
        End If
    Next index
    ResolveRequiredHeaders = result
End Function

Private Function LoadRequiredColumns(ByVal ws As Worksheet, _
                                     ByVal lastRow As Long, _
                                     ByVal sourceColumns As Variant) As Variant
    Dim result() As Variant
    Dim columnValues As Variant
    Dim fieldIndex As Long
    Dim rowIndex As Long
    Dim rowCount As Long

    rowCount = lastRow - 1
    ReDim result(1 To rowCount, 1 To 6)

    For fieldIndex = LBound(sourceColumns) To UBound(sourceColumns)
        columnValues = ws.Range( _
            ws.Cells(2, CLng(sourceColumns(fieldIndex))), _
            ws.Cells(lastRow, CLng(sourceColumns(fieldIndex)))).Value2

        If rowCount = 1 Then
            result(1, fieldIndex + 1) = columnValues
        Else
            For rowIndex = 1 To rowCount
                result(rowIndex, fieldIndex + 1) = columnValues(rowIndex, 1)
            Next rowIndex
        End If
    Next fieldIndex

    LoadRequiredColumns = result
End Function

Private Sub ValidateSourceRow(ByVal values As Variant, ByVal dataRow As Long, _
                              ByVal sheetRow As Long, ByVal columns As Variant)
    Dim dateValue As Variant
    Dim personValue As Variant
    Dim productValue As Variant
    Dim quantityValue As Variant
    Dim priceValue As Variant
    Dim salesValue As Variant
    Dim expectedAmount As Double

    dateValue = values(dataRow, CLng(columns(0)))
    personValue = values(dataRow, CLng(columns(1)))
    productValue = values(dataRow, CLng(columns(2)))
    quantityValue = values(dataRow, CLng(columns(3)))
    priceValue = values(dataRow, CLng(columns(4)))
    salesValue = values(dataRow, CLng(columns(5)))

    If IsError(dateValue) Then
        Err.Raise vbObjectError + 711, , _
            "第 " & sheetRow & " 列的日期不是有效 Excel 日期值。"
    End If
    If Not IsNumeric(dateValue) Or VarType(dateValue) = vbString Then
        Err.Raise vbObjectError + 711, , _
            "第 " & sheetRow & " 列的日期不是有效 Excel 日期值。"
    End If
    If CDbl(dateValue) <= 0 Or CDbl(dateValue) > 2958465 Then
        Err.Raise vbObjectError + 712, , _
            "第 " & sheetRow & " 列的日期超出 Excel 可接受範圍。"
    End If

    If IsError(personValue) Then
        Err.Raise vbObjectError + 713, , _
            "第 " & sheetRow & " 列的業務名稱為空白或錯誤值。"
    End If
    If Len(Trim$(CStr(personValue))) = 0 Then
        Err.Raise vbObjectError + 713, , _
            "第 " & sheetRow & " 列的業務名稱為空白或錯誤值。"
    End If
    If IsError(productValue) Then
        Err.Raise vbObjectError + 714, , _
            "第 " & sheetRow & " 列的產品名稱為空白或錯誤值。"
    End If
    If Len(Trim$(CStr(productValue))) = 0 Then
        Err.Raise vbObjectError + 714, , _
            "第 " & sheetRow & " 列的產品名稱為空白或錯誤值。"
    End If

    If IsError(quantityValue) Then
        Err.Raise vbObjectError + 715, , _
            "第 " & sheetRow & " 列的數量不是數字。"
    End If
    If Not IsNumeric(quantityValue) Or VarType(quantityValue) = vbString Then
        Err.Raise vbObjectError + 715, , _
            "第 " & sheetRow & " 列的數量不是數字。"
    End If
    If CDbl(quantityValue) < 0 Then
        Err.Raise vbObjectError + 716, , _
            "第 " & sheetRow & " 列的數量小於 0；請先修訂退貨政策。"
    End If

    If IsError(priceValue) Then
        Err.Raise vbObjectError + 717, , _
            "第 " & sheetRow & " 列的單價不是數字。"
    End If
    If Not IsNumeric(priceValue) Or VarType(priceValue) = vbString Then
        Err.Raise vbObjectError + 717, , _
            "第 " & sheetRow & " 列的單價不是數字。"
    End If
    If CDbl(priceValue) < 0 Then
        Err.Raise vbObjectError + 718, , _
            "第 " & sheetRow & " 列的單價小於 0。"
    End If

    If IsError(salesValue) Then
        Err.Raise vbObjectError + 719, , _
            "第 " & sheetRow & " 列的銷售額不是數字或是公式錯誤。"
    End If
    If Not IsNumeric(salesValue) Or VarType(salesValue) = vbString Then
        Err.Raise vbObjectError + 719, , _
            "第 " & sheetRow & " 列的銷售額不是數字或是公式錯誤。"
    End If

    expectedAmount = CDbl(quantityValue) * CDbl(priceValue)
    If Abs(CDbl(salesValue) - expectedAmount) > MONEY_TOLERANCE Then
        Err.Raise vbObjectError + 720, , _
            "第 " & sheetRow & " 列的銷售額與數量 × 單價不一致。"
    End If
End Sub

Private Function RequiredFieldsAreBlank(ByVal values As Variant, _
                                        ByVal dataRow As Long, _
                                        ByVal columns As Variant) As Boolean
    Dim index As Long
    Dim value As Variant

    RequiredFieldsAreBlank = True
    For index = LBound(columns) To UBound(columns)
        value = values(dataRow, CLng(columns(index)))
        If IsError(value) Then
            RequiredFieldsAreBlank = False
            Exit Function
        End If
        If Len(Trim$(CStr(value))) > 0 Then
            RequiredFieldsAreBlank = False
            Exit Function
        End If
    Next index
End Function

Private Function ValidateOwnedReportSheet(ByVal ws As Worksheet) As Long
    Dim chartObject As ChartObject
    Dim markerValue As Variant
    Dim rowsValue As Variant
    Dim storedRows As Long

    markerValue = ws.Range(REPORT_MARKER_CELL).Value2
    If IsError(markerValue) Then
        Err.Raise vbObjectError + 721, , _
            "已存在未由本程式標記的「報表」工作表；為免覆寫，程序已停止。"
    End If
    If CStr(markerValue) <> REPORT_MARKER Then
        Err.Raise vbObjectError + 721, , _
            "已存在未由本程式標記的「報表」工作表；為免覆寫，程序已停止。"
    End If

    rowsValue = ws.Range(REPORT_ROWS_CELL).Value2
    If IsError(rowsValue) Then
        Err.Raise vbObjectError + 722, , "報表擁有權資料損壞；程序已停止。"
    End If
    If Not IsNumeric(rowsValue) Then
        Err.Raise vbObjectError + 722, , "報表擁有權資料損壞；程序已停止。"
    End If
    storedRows = CLng(rowsValue)
    If storedRows < 20 Or storedRows > MAX_DATA_ROWS + 20 Then
        Err.Raise vbObjectError + 723, , "報表生成範圍資料不合理；程序已停止。"
    End If

    If LastUsedColumn(ws) > 14 Or LastUsedRow(ws) > storedRows Then
        Err.Raise vbObjectError + 724, , _
            "報表生成範圍以外出現內容；請先人工檢查。"
    End If

    If ws.Shapes.Count <> ws.ChartObjects.Count Then
        Err.Raise vbObjectError + 725, , _
            "報表含未知的非圖表物件；程序已停止。"
    End If

    For Each chartObject In ws.ChartObjects
        If StrComp(chartObject.Name, SALES_CHART_NAME, vbTextCompare) <> 0 And _
           StrComp(chartObject.Name, SHARE_CHART_NAME, vbTextCompare) <> 0 Then
            Err.Raise vbObjectError + 725, , _
                "報表含未知圖表：" & chartObject.Name
        End If
    Next chartObject

    ValidateOwnedReportSheet = storedRows
End Function

Private Sub WriteOwnershipMarker(ByVal ws As Worksheet, ByVal clearRows As Long)
    ws.Range(REPORT_MARKER_CELL).Value2 = REPORT_MARKER
    ws.Range(REPORT_ROWS_CELL).Value2 = clearRows
    ws.Columns("N").Hidden = True
End Sub

Private Sub WriteSummary(ByVal ws As Worksheet, ByRef people() As String, _
                         ByRef totals() As Double, ByVal personCount As Long, _
                         ByVal grandTotal As Double, ByVal validRowCount As Long, _
                         ByVal totalRow As Long)
    Dim index As Long
    Dim reportRow As Long

    ws.Range("A1").Value2 = "銷售彙總報表"
    ws.Range("A2").Value2 = "建立時間"
    ws.Range("B2").Value = Now
    ws.Range("A3").Value2 = "通過驗證的來源列"
    ws.Range("B3").Value2 = validRowCount
    ws.Range("A4").Value2 = "業務"
    ws.Range("B4").Value2 = "銷售額"
    ws.Range("C4").Value2 = "佔比"

    ws.Range("A5:A" & (personCount + 4)).NumberFormat = "@"
    For index = 1 To personCount
        reportRow = index + 4
        ws.Cells(reportRow, 1).Value2 = SafeCellText(people(index))
        ws.Cells(reportRow, 2).Value2 = totals(index)
        If grandTotal = 0 Then
            ws.Cells(reportRow, 3).Value2 = 0
        Else
            ws.Cells(reportRow, 3).Value2 = totals(index) / grandTotal
        End If
    Next index

    ws.Cells(totalRow, 1).Value2 = "總計"
    ws.Cells(totalRow, 2).Value2 = grandTotal
    If grandTotal = 0 Then
        ws.Cells(totalRow, 3).Value2 = 0
    Else
        ws.Cells(totalRow, 3).Value2 = 1
    End If

    ws.Range("A1").Font.Size = 20
    ws.Range("A1").Font.Bold = True
    ws.Range("A4:C4").Font.Bold = True
    ws.Range("A4:C4").Interior.Color = RGB(224, 239, 228)
    ws.Range("B5:B" & totalRow).NumberFormat = "HK$#,##0.00"
    ws.Range("C5:C" & totalRow).NumberFormat = "0.00%"
    ws.Range("A" & totalRow & ":C" & totalRow).Font.Bold = True
    ws.Columns("A:C").AutoFit
End Sub

Private Function AddReportCharts(ByVal ws As Worksheet, _
                                 ByRef totals() As Double, _
                                 ByVal personCount As Long, _
                                 ByVal grandTotal As Double) As Boolean
    Dim lastDataRow As Long
    Dim chartObject As ChartObject
    Dim chartSeries As Series
    Dim createPie As Boolean

    lastDataRow = personCount + 4

    Set chartObject = ws.ChartObjects.Add( _
        Left:=ws.Range("E4").Left, Top:=ws.Range("E4").Top, _
        Width:=ws.Range("E4:I4").Width, Height:=230)
    chartObject.Name = SALES_CHART_NAME
    With chartObject.Chart
        .ChartType = xlColumnClustered
        Do While .SeriesCollection.Count > 0
            .SeriesCollection(1).Delete
        Loop
        Set chartSeries = .SeriesCollection.NewSeries
        chartSeries.Name = "銷售額"
        chartSeries.XValues = ws.Range("A5:A" & lastDataRow)
        chartSeries.Values = ws.Range("B5:B" & lastDataRow)
        .HasTitle = True
        .ChartTitle.Text = "各業務銷售額"
        .HasLegend = False
    End With

    createPie = PieChartIsSuitable(totals, personCount, grandTotal)
    If createPie Then
        Set chartObject = ws.ChartObjects.Add( _
            Left:=ws.Range("J4").Left, Top:=ws.Range("J4").Top, _
            Width:=ws.Range("J4:M4").Width, Height:=230)
        chartObject.Name = SHARE_CHART_NAME
        With chartObject.Chart
            .ChartType = xlPie
            Do While .SeriesCollection.Count > 0
                .SeriesCollection(1).Delete
            Loop
            Set chartSeries = .SeriesCollection.NewSeries
            chartSeries.Name = "銷售佔比"
            chartSeries.XValues = ws.Range("A5:A" & lastDataRow)
            chartSeries.Values = ws.Range("B5:B" & lastDataRow)
            chartSeries.ApplyDataLabels
            chartSeries.DataLabels.ShowCategoryName = True
            chartSeries.DataLabels.ShowPercentage = True
            chartSeries.DataLabels.ShowValue = False
            .HasTitle = True
            .ChartTitle.Text = "各業務銷售佔比"
            .HasLegend = True
        End With
    Else
        ws.Range("J4").Value2 = "圓餅圖已按政策略過"
        ws.Range("J5").Value2 = "只適用於 2–12 個正數分類及正數總額。"
        ws.Range("J4:J5").WrapText = True
    End If

    AddReportCharts = createPie
End Function

Private Function PieChartIsSuitable(ByRef totals() As Double, _
                                    ByVal personCount As Long, _
                                    ByVal grandTotal As Double) As Boolean
    Dim index As Long

    If grandTotal <= 0 Then Exit Function
    If personCount < 2 Or personCount > MAX_PIE_CATEGORIES Then Exit Function
    For index = 1 To personCount
        If totals(index) <= 0 Then Exit Function
    Next index
    PieChartIsSuitable = True
End Function

Private Sub ConfigurePrintLayout(ByVal ws As Worksheet, ByVal totalRow As Long, _
                                 ByVal pieCreated As Boolean)
    Dim lastPrintRow As Long

    lastPrintRow = totalRow + 2
    If lastPrintRow < 20 Then lastPrintRow = 20

    With ws.PageSetup
        .PrintArea = ws.Range("A1:M" & lastPrintRow).Address
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .CenterHorizontally = True
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.4)
        .BottomMargin = Application.InchesToPoints(0.4)
    End With
End Sub

Private Function SafeCellText(ByVal value As String) As String
    Dim firstCharacter As String

    If Len(value) = 0 Then Exit Function
    firstCharacter = Left$(value, 1)
    If firstCharacter = "=" Or firstCharacter = "+" Or _
       firstCharacter = "-" Or firstCharacter = "@" Then
        SafeCellText = "'" & value
    Else
        SafeCellText = value
    End If
End Function

Private Function GetWorksheet(ByVal workbook As Workbook, _
                              ByVal sheetName As String) As Worksheet
    On Error Resume Next
    Set GetWorksheet = workbook.Worksheets(sheetName)
    On Error GoTo 0
End Function

Private Function LastUsedRow(ByVal ws As Worksheet) As Long
    Dim found As Range
    Set found = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), _
                              LookIn:=xlFormulas, LookAt:=xlPart, _
                              SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                              MatchCase:=False)
    If found Is Nothing Then
        LastUsedRow = 0
    Else
        LastUsedRow = found.Row
    End If
End Function

Private Function LastUsedColumn(ByVal ws As Worksheet) As Long
    Dim found As Range
    Set found = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), _
                              LookIn:=xlFormulas, LookAt:=xlPart, _
                              SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
                              MatchCase:=False)
    If found Is Nothing Then
        LastUsedColumn = 0
    Else
        LastUsedColumn = found.Column
    End If
End Function

Private Function FindUniqueHeaderColumn(ByVal ws As Worksheet, _
                                        ByVal headerText As String, _
                                        ByVal lastCol As Long) As Long
    Dim col As Long
    Dim matches As Long
    Dim matchedColumn As Long
    Dim cellValue As Variant

    For col = 1 To lastCol
        cellValue = ws.Cells(1, col).Value2
        If Not IsError(cellValue) Then
            If StrComp(Trim$(CStr(cellValue)), headerText, vbTextCompare) = 0 Then
                matches = matches + 1
                matchedColumn = col
            End If
        End If
    Next col
    If matches = 1 Then FindUniqueHeaderColumn = matchedColumn
End Function

Private Function FindPersonIndex(ByRef people() As String, _
                                 ByVal personCount As Long, _
                                 ByVal personName As String) As Long
    Dim index As Long
    For index = 1 To personCount
        If StrComp(people(index), personName, vbTextCompare) = 0 Then
            FindPersonIndex = index
            Exit Function
        End If
    Next index
End Function

Private Sub SortSummaryDescending(ByRef people() As String, _
                                  ByRef totals() As Double, _
                                  ByVal personCount As Long)
    Dim leftIndex As Long
    Dim rightIndex As Long
    Dim tempPerson As String
    Dim tempTotal As Double

    For leftIndex = 1 To personCount - 1
        For rightIndex = leftIndex + 1 To personCount
            If totals(rightIndex) > totals(leftIndex) Then
                tempPerson = people(leftIndex)
                people(leftIndex) = people(rightIndex)
                people(rightIndex) = tempPerson
                tempTotal = totals(leftIndex)
                totals(leftIndex) = totals(rightIndex)
                totals(rightIndex) = tempTotal
            End If
        Next rightIndex
    Next leftIndex
End Sub

Private Sub DeleteKnownCharts(ByVal ws As Worksheet)
    Dim index As Long
    For index = ws.ChartObjects.Count To 1 Step -1
        If StrComp(ws.ChartObjects(index).Name, SALES_CHART_NAME, _
                   vbTextCompare) = 0 Or _
           StrComp(ws.ChartObjects(index).Name, SHARE_CHART_NAME, _
                   vbTextCompare) = 0 Then
            ws.ChartObjects(index).Delete
        End If
    Next index
End Sub

Private Function NextAvailablePdfPath(ByVal folderPath As String, _
                                      ByVal baseName As String) As String
    Dim candidate As String
    Dim suffix As Long

    candidate = folderPath & Application.PathSeparator & baseName & ".pdf"
    suffix = 2
    Do While Len(Dir$(candidate)) > 0
        candidate = folderPath & Application.PathSeparator & _
                    baseName & "_" & suffix & ".pdf"
        suffix = suffix + 1
    Loop
    NextAvailablePdfPath = candidate
End Function

Private Sub RestoreApplicationState(ByVal calculationMode As XlCalculation, _
                                    ByVal eventsEnabled As Boolean, _
                                    ByVal screenUpdatingEnabled As Boolean, _
                                    ByVal displayAlertsEnabled As Boolean, _
                                    ByVal statusBarValue As Variant)
    On Error Resume Next
    Application.Calculation = calculationMode
    Application.EnableEvents = eventsEnabled
    Application.ScreenUpdating = screenUpdatingEnabled
    Application.DisplayAlerts = displayAlertsEnabled
    Application.StatusBar = statusBarValue
    Err.Clear
    On Error GoTo 0
End Sub

怎樣審查這段 VBA，而不是盲目相信

1. 活頁簿：必須先儲存為本機 .xlsm；未儲存或不合格式便停止。
2. 範圍：所有工作表都由 ThisWorkbook.Worksheets("名稱") 取得，沒有 ActiveSheet、Selection 或自動開啟事件。
3. 來源：程式不會排序、清空或改寫「銷售明細」的公式和輸入；讀取快照前會執行 wsSource.Calculate，避免把過期的公式結果當成最新金額。
4. 標題與資料：六個必要標題必須各出現一次；每個非空白列都要通過日期、業務、產品、數量、單價、銷售額和重新計算核對。
5. 先驗後寫：兩輪驗證全部通過後，才會接觸專用報表；寫出的文字會防止被 Excel 當作公式執行。
6. 重跑：只接受正確擁有權標記和已知圖表名稱 chtSalesByPerson、chtSalesShare；未知內容令程式停止。
7. 圖表：直條圖固定生成；圓餅圖只在總額為正、分類為 2 至 12 個且每項均為正數時生成。
8. 檔案：只讀取活頁簿路徑並建立新 PDF；沒有刪檔、Shell、網絡、寄信或外部連線。
9. 覆寫：時間戳仍撞名時加序號，不覆寫既有 PDF。
10. 錯誤：顯示處理階段和錯誤編號，並以容錯方式嘗試還原 Calculation、EnableEvents、ScreenUpdating、DisplayAlerts 和 StatusBar。

仍要注意：即使程式拒絕未標記報表，仍應把「報表」視為生成專用工作表，不要在其中手動加入其他內容或按鈕。為避免線性搜尋、排序和圖表在極端分類數量下凍結 Excel，範例最多接受 50 個業務分類；更多分類應改用樞紐分析表、Power Query 或分拆報告。圓餅圖不適用時只會保留直條圖；列印範圍會按這次摘要和圖表動態計算。字型、紙張、頁數和 PDF 版面仍要在 Windows、Mac 及實際驅動各自測試。

步驟七：生成圖表後，逐項驗收資料來源

直條圖回答「哪位業務的銷售額較高」，固定建立；圓餅圖只回答「適合的正數總額內各業務的份額」，所以只有總額為正、分類為 2 至 12 個且每項均為正數時才建立。生成後不要先看顏色，先右鍵 Select Data／選取資料，確認分類來自業務名稱、數值來自正確摘要列，而且沒有把總計列畫入。

步驟八：按輸出動態設定列印範圍，再匯出 PDF

Microsoft 說明列印範圍只會輸出指定範圍，而多個不相連範圍可變成多頁。範例按摘要末列和實際生成的圖表計算一個連續列印範圍，再設定橫向和一頁闊；紙張尺寸由使用者在目標地區和驅動實機確認。最後用 Worksheet.ExportAsFixedFormat 只匯出「報表」工作表；IgnorePrintAreas:=False 表示尊重這個動態範圍。

匯出成功的 MsgBox 只證明 Excel 沒有拋出錯誤，不證明 PDF 正確。必須開啟 PDF，核對頁數、報表期、總額、至少兩位業務數字、圖表標題、截字、字型、頁邊和是否出現空白頁。

步驟九：五項結果檢查，再加重跑與失敗測試

1. 來源列數：記錄非空白來源列、資料期間和驗證失敗數。
2. 總銷售額：重新計算總額、來源銷售額合計和摘要小計合計必須一致；抽查三位業務的原始列。
3. 佔比：非零合資格總額的底層比例合計為 100%，並理解畫面四捨五入差異。
4. 圖表：直條圖必須存在；圓餅圖按政策存在或跳過。分類和數值範圍正確，總計列沒有進入圖表。
5. PDF：頁數、標題、金額、百分比、字型和實際生成的圖表完整。

重跑測試：第二次執行的資料不倍增；圖表仍為符合政策的一張或兩張；舊 PDF 保留並產生新時間戳或碰撞序號檔。失敗測試：分別把日期改成文字、清空業務、把數量改成負數、令銷售額與數量 × 單價不一致，再加入未知圖形；程式都應在清理舊報表前停止並指出階段或列號。

若結果不對，把證據交給 AI，而不是只說「不能用」。可提供錯誤編號、處理階段、偵錯反白行、虛構欄位結構、預期和實際總額、Windows／Mac 版本，以及你已驗證的最小樣本。要求 AI 只修正已證實問題，並重列權限和副作用。

私隱與企業資料：在 Excel 本機執行，不等於沒有上傳風險

這段 VBA 在本機 Excel 執行，且沒有網絡程式碼；但如果你把真實工作簿、截圖或資料列貼到 ChatGPT，資料已離開 Excel。個人 ChatGPT 的對話是否用於模型改進可由 Data Controls 管理；ChatGPT Business 工作區資料預設不用於訓練，但公司環境仍要確認獲批准帳戶、保留期、存取控制、跨境處理、合約和香港個人資料責任，不能只憑產品名稱推斷流程已獲批准。

• 提示詞只放欄位和虛構樣本；姓名改成「樣本甲」，電郵使用 example.test。
• 錯誤截圖裁走工作簿名、共用路徑、帳戶、客戶資料和其他工作表。
• 僅替換姓名仍不足以匿名化；罕見的日期、金額和產品組合仍可能識別一宗交易。
• 正式使用前由資料擁有人、IT 或私隱負責人確認工具和流程。
• PDF 本身可能包含敏感報表，仍需檔案權限、分享和保留政策。

Windows、Mac 和 Excel 網頁版差異

Windows 和 Mac 的核心 Excel Table、公式、圖表和 PDF 功能相近，但快捷鍵、Developer 位置、巨集安全、檔案權限、字型和列印引擎會不同。範例使用 Application.PathSeparator 而不是硬寫斜線，並避免 Windows 專用 Shell 或 COM 外部程式；仍要在每個目標平台實測。Mac 預設也是「停用巨集並通知」；不要改成全域啟用所有巨集。

Excel for the web 不能建立、執行或編輯 VBA。若流程必須在瀏覽器、排程或多人共同操作，評估 Office Scripts、Power Automate、Power Query 或由受管伺服器產生報表；不要假裝把 VBA 放在雲端便自然安全。

發布前最後清單

• 來源檔有備份，測試檔是本機 .xlsm 並已關閉重開。
• 六個標題唯一，Table 名稱正確，虛構小樣本涵蓋零、文字、錯誤和不一致金額。
• 所有公式有手算例子；重新計算總額、來源銷售額和業務小計互相一致。
• VBA 沒有 Shell、刪檔、網絡、寄信、ActiveSheet 或自動開啟事件。
• 「報表」是帶擁有權標記的生成專用工作表，沒有未知內容或物件。
• 業務分類不超過 50；更多分類已轉用樞紐分析表、Power Query 或分拆報告。
• 直條圖必須通過；圓餅圖按正數總額、正數分類和 2 至 12 個分類政策生成或跳過。
• 按實際輸出設定列印範圍；紙張、驅動、PDF 頁數和關鍵數字已實機抽查。
• 第二次執行不堆疊圖表、不倍增數字、不覆寫舊 PDF。
• 真實資料和 PDF 的使用、分享、保留符合公司及私隱政策。

延伸閱讀

如果你仍在探索 AI 適合協助哪些 Excel 任務，可先看 ChatGPT Excel 分析與報表指南；若要練習 VBE、Module、.xlsm 和巨集安全，閱讀 ChatGPT Excel VBA 入門。

需要另一個防守式 VBA 案例，可做 Google 表單複選資料拆列；需要可篩選、下鑽的互動體驗，則比較 ChatGPT Visualize 互動資料教學。處理公司資料前，再閱讀 香港 ChatGPT 私隱指南和 工作提示詞實例。

總結：一鍵只是最後一按

可持續的 Excel 自動報表，不是把「幫我做圖表和 PDF」交給 ChatGPT 後直接執行，而是先固定資料合約，再驗算公式、限制程式權限、建立可重跑輸出、核對圖表來源、控制 PDF 版面，最後用失敗案例證明流程會安全停止。完成這些工作後，那個按鈕才真正值得被稱為「一鍵」。