البحث في الموقع

السلام عليكم لإنعدام خبرتي في الأكواد ... أطلب مساعدة في التعديل على هذا الكود معي الكود التالي: حيث هذا الكود يلغي قائمة صيّغ الحفظ المختلفه في نافذة "حفظ باسم" ويعطي خيارين "للحفظ بإسم" فقط هما xlsm و xls Excel Macro-Enabled Workbook (*.xlsm) Excel 97-2003 Workbook (*.xls) أنا أريد ألغي الخيارين أعلاه أيضا وأستبدالهم بالحفظ إلى PDF فقط لا غير هذا هو الكود Private Sub CustomSave(Optional SaveAs As Boolean) 'Declare the variables Dim ActiveSht As Object Dim FileFormat As Variant Dim FileName As String Dim FileFilter As String Dim FilterIndex As Integer Dim Msg As String Dim Ans As Integer Dim OrigSaved As Boolean Dim WorkbookSaved As Boolean 'Turn off screen updating Application.ScreenUpdating = False 'Turn off events so that the BeforeSave event doesn't occur Application.EnableEvents = False 'Assign the status of the workbook's Saved property to a variable OrigSaved = Me.Saved 'Assign the active sheet to an object variable Set ActiveSht = ActiveSheet 'Call the HideAllSheets routine Call HideAllSheets 'Save workbook or prompt for SaveAs filename If SaveAs Or Len(Me.Path) = 0 Then If Val(Application.Version) < 12 Then FileFilter = "Microsoft Office Excel Workbook (*.xls), *.xls" FilterIndex = 1 Else FileFilter = "Excel Macro-Enabled Workbook (*.xlsm), *.xlsm, " & _ "Excel 97-2003 Workbook (*.xls), *.xls" If Right(Me.Name, 4) = ".xls" Then FilterIndex = 2 Else FilterIndex = 1 End If End If Do FileName = Application.GetSaveAsFilename( _ InitialFileName:=Me.Name, _ FileFilter:=FileFilter, _ FilterIndex:=FilterIndex, _ Title:="SaveAs") If FileName = "False" Then Exit Do If IsLegalFilename(FileName) = False Then Msg = "The file name is invalid. Try one of the " Msg = Msg & "following:" & vbCrLf & vbCrLf Msg = Msg & Chr(149) & " Make sure that the file name " Msg = Msg & "does not contain any" & vbCrLf Msg = Msg & " of the following characters: " Msg = Msg & "< > ? [ ] : | or *" & vbCrLf Msg = Msg & Chr(149) & " Make sure that the file/path " Msg = Msg & "name does not exceed" & vbCrLf Msg = Msg & " more than 218 characters." MsgBox Msg, vbExclamation, "Invalid File Name" Else If Val(Application.Version) < 12 Then FileFormat = -4143 Else If Right(FileName, 4) = ".xls" Then FileFormat = 56 Else FileFormat = 52 End If End If If Len(Dir(FileName)) = 0 Then Application.DisplayAlerts = False Me.SaveAs FileName, FileFormat Application.DisplayAlerts = True WorkbookSaved = True Else Ans = MsgBox("'" & FileName & "' already exists. " & _ "Do you want to replace it?", vbQuestion + vbYesNo, _ "Confirm Save As") If Ans = vbYes Then Application.DisplayAlerts = False Me.SaveAs FileName, FileFormat Application.DisplayAlerts = True WorkbookSaved = True End If End If End If Loop Until Me.Saved Else Application.DisplayAlerts = False Me.Save Application.DisplayAlerts = True WorkbookSaved = True End If 'Call the ShowAllSheets routine Call ShowAllSheets 'Activate the prior active sheet ActiveSht.Activate 'Set the workbook's Saved property If WorkbookSaved Then Me.Saved = True Else Me.Saved = OrigSaved End If 'Turn on screen updating Application.ScreenUpdating = True 'Turn on events Application.EnableEvents = True End Sub