צירוף קובץ PDF למייל שנשלח אוטומטית- לפי דף פעיל בלבד

שלום !

יש לי קובץ עם מלא דפים, כאשר יש תמיד דף אחד פעיל (והשאר במצב מוסתר בלתי נראה HIDDEN).

יש לי מאקרו שתפקידה:

1. להמיר את הדף הפעיל לפורמט PDF ושמירתו (באופן זמני) על שולחן העבודה
2. לפתוח מייל חדש עם הקובץ PDF מצורף.
3. לאחר השליחה האוטומטית, הקובץ PDF נמחק מהמחשב.

הבעייה שלי היא שהקוד שיש לי עובד מעולה בקובץ שיש בו רק דף אחד.

בקובץ שלי שיש בו מלא דפים (אפילו שרק אחד מהם פתוח ופעיל בכל זמן נתון), הפקודה הזו אינה עובדת משום מה.

אני ממש לא מבין יותר מדי בVBA

אשמח לעזרתכם כדי לפתור את הבעייה....

זוהי המאקרו:

Sub Mail()

Dim FileExtStr As String

Dim FileFormatNum As Long

Dim Sourcewb As Workbook

Dim destwb As Workbook

Dim TempFilePath As String

Dim TempFileName As String

Dim OutApp As Object

Dim OutMail As Object

Dim S As Shape

Dim sNomFic As String, sRep As String, WshShell As Object

With Application

.ScreenUpdating = False

.EnableEvents = False

End With

' Créer une instance Windows Script pour retrouver le chemin du bureau  (לשמור על שולחן העבודה)

Set WshShell = CreateObject("WScript.Shell")

sRep = WshShell.SpecialFolders("Desktop")

Set WshShell = Nothing

' Définit le nom du fichier à enregistrer  (להגדיר את שם הקובץ לשמירה)

sNomFic = Sheets("שם דף").Range("A1").Value & ".pdf"

' Enregistrer la feuille en PDF  (לשמור את הקובץ בפורמט PDF)

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=sRep & "" & sNomFic, _

Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _

OpenAfterPublish:=False

(לפתוח מייל ולצרף את הקובץ)

Set OutApp = CreateObject("outlook.application")

Set OutMail = OutApp.CreateItem(0)

With OutMail

.To = Sheets("שם דף").Range("C8").Value (נמען המייל לפי כתובת מייל שרשומה בתא מסויים בדף הפעיל)

.Cc = "******@gmail.com"

.Attachments.Add (sRep & "" & sNomFic)

.Subject = Sheets("שם דף").Range("A1").Value

.Display

End With

OutMail.send

With Application

.ScreenUpdating = True

.EnableEvents = True

End With

Kill (sRep & "" & sNomFic) (מחיקת הקובץ PDF)

End Sub