تعديل على كود ترحيل

[طارق_نادر]

اخواني لدي كود ترحيل ولكن اريد كود معدل عليه  بحيث  يسمح بالترحيل لورقة محمية لان عندما عملت على حماية الورقة المراد الترحيل عليها لم ينجح الترحيل كما اريد

[عبد الله بولنوار]

لو رفعت الملف افضل

 

 

في بداية كود الترحيل

 

ضع هذا السطر

ActiveSheet.Unprotect (123)

بحيث  123 هو كود الحماية

 

و في نهاية كود الترحيل ضع هذا الكود

ActiveSheet.Protect (123)

لكي يتم غلق الملف بنفس كلمة المرور

[طارق_نادر]

كل الشكر والتقدير تم المطلوب بكل نجاح جزاك  الله خير  طلب اخر اذا تكرمت تعديل على كود طباعة بحيث يطبع ورقة مخفية يعني كود الطباعة الذي لدي لديه خيارات للورقات الملف الظاهرة اما اذا اخفيت ورقة لاتظهر من ضمن خيارات الطباعة

[عبد الله بولنوار]

ممكن تنسخ كود الطباعة الذي لديك

[طارق_نادر]

هذا هو الكود اهداني اياه احد الاخوان الافاضل في المنتدى من مكتبته الخاصة كل الشكر لهو ولك اخي الفاضل

Private Sub CmdPrint_Click()
'   Display "Printer Setup" dialog box
    Application.Dialogs(xlDialogPrinterSetup).Show
'   Option Explicit
'   Sub SelectSheets()
    Dim i As Integer
    Dim TopPos As Integer
    Dim SheetCount As Integer
    Dim PrintDlg As DialogSheet
    Dim CurrentSheet As Worksheet
    Dim cb As CheckBox
    Dim Numcop As Long
    Application.ScreenUpdating = False
'   Check for protected workbook
    If ActiveWorkbook.ProtectStructure Then
        MsgBox "Workbook is protected.", vbCritical
        Exit Sub
    End If
'   Add a temporary dialog sheet
    Set CurrentSheet = ActiveSheet
    X = CurrentSheet.Name
    Set PrintDlg = ActiveWorkbook.DialogSheets.Add
    SheetCount = 0
'   Add the checkboxes
    TopPos = 40
    For i = 1 To ActiveWorkbook.Worksheets.Count
        Set CurrentSheet = ActiveWorkbook.Worksheets(i)
'       Skip empty sheets and hidden sheets
        If Application.CountA(CurrentSheet.Cells) <> 0 And _
            CurrentSheet.Visible Then
            SheetCount = SheetCount + 1
            PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
                PrintDlg.CheckBoxes(SheetCount).Text = _
                    CurrentSheet.Name
            TopPos = TopPos + 13
        End If
    Next i
'   Move the OK and Cancel buttons
    PrintDlg.Buttons.Left = 240
'   Set dialog height, width, and caption
    With PrintDlg.DialogFrame
        .Height = Application.Max _
            (68, PrintDlg.DialogFrame.Top + TopPos - 34)
        .Width = 230
        .Caption = "Select sheets to print"
    End With
'   Change tab order of OK and Cancel buttons
'   so the 1st option button will have the focus
    PrintDlg.Buttons("Button 2").BringToFront
    PrintDlg.Buttons("Button 3").BringToFront
'   Get the number of print copies for each report
    Numcop = Application.InputBox("Enter number of copies to print:", _
    "How Many Copies?", 1, Type:=1)
    If Numcop = 0 Then
    ElseIf Len(Numcop) > 0 Then
        End If
'   Display the dialog box
    CurrentSheet.Activate
    Dim cnt As Integer
    Application.ScreenUpdating = True
    If SheetCount <> 0 Then
        If PrintDlg.Show Then
            For Each cb In PrintDlg.CheckBoxes
                If cb.Value = xlOn Then
                    If cnt = 0 Then
                    Worksheets(cb.Caption).Select ' Replace:=False 'Activate
                Else
                    Worksheets(cb.Caption).Select Replace:=False 'Activate
                End If
                    cnt = cnt + 1
                End If
                Next cb
                    ActiveWindow.SelectedSheets.PrintOut copies:=Numcop
                    'ActiveSheet.PrintPreview 'for debugging
        End If
    Else
        MsgBox "All worksheets are empty."
    End If
'   Delete temporary dialog sheet (without a warning)
    Application.DisplayAlerts = False
    PrintDlg.Delete
'   Reactivate original sheet
    Sheets(X).Select
End Sub