☰

巨集未複製儲存格中的資料驗證

tag-icon • tag-icon microsoft-excel vba macros
巨集未複製儲存格中的資料驗證

我有一個巨集可以從工作表中複製所選內容並將其作為單獨的附件透過電子郵件發送，但是它不會複製這些單元格中存在的資料驗證。

在該表中，AT、AU、AV、AW 和 AY 欄位中存在驗證。當我運行下面的程式碼時，它不會將驗證複製到透過電子郵件發送的工作表中。我需要附件在這些列中具有與原始工作表相同的驗證和相同的格式。

Sub send_email()
Dim Data, Dict As Object, Id As String, File As String, i As Long
Set Dict = CreateObject("scripting.dictionary")
With Cells(1).CurrentRegion
    Data = .Value
    For i = 2 To UBound(Data)
        If Not Dict.exists(Data(i, 59)) Then
            Id = Data(i, 58)
            File = ThisWorkbook.Path & "\" & Id & " - PCP" & ".xlsx"
            Dict.Add Data(i, 59), 1
            .AutoFilter 59, Data(i, 59)
            .SpecialCells(12).Copy Sheets.Add.Cells(1)
            With ActiveSheet
                .Copy
                With ActiveWorkbook
                    .ActiveSheet.Name = "Sheet1"
                    .SaveAs File
                    .Close
                End With
                Application.DisplayAlerts = False: .Delete: Application.DisplayAlerts = True
            End With
            With CreateObject("Outlook.Application").CreateItem(0)
                .display
                .To = Data(i, 59)
                .Subject = "Work Assignment for Today"
                .HTMLBody = "Good Morning " & "<br><br>" & "Please find attached your work assignment for the day" & .HTMLBody
                .Attachments.Add File
                .display '! Change to Send after testing
            End With
            Kill File
            .AutoFilter
        End If
    Next i
End With
End Sub

答案1

我能夠使用下面的程式碼解決這個問題。

ActiveWorkbook.Worksheets(Array(.Name, "Disp")).Copy

相關內容