تضمين فيديو من على اليوتيوب لملف إكسيل Embed YouTube Video Into Excel File

السلام عليكم ورحمة الله وبركاته

أقدم لكم طريقة تضمين فيديو من على اليوتيوب لملف إكسيل وبدون أكواد ، وبطريقة سهلة ويسيرة إن شاء الله

خطوات العمل : 

قم بنسخ عنوان الفيديو المراد تضمينه وإدراجه داخل ملف الإكسيل ويكون العنوان بهذا الشكل على سبيل المثال

https://www.youtube.com/watch?v=4rz56EHfm3w

قم بحذف كلمة watch وعلامة الاستفهام التي تلي الكلمة ، وقم باستبدال علامة يساوي = بعلامة / ، ليصبح العنوان بهذا الشكل

https://www.youtube.com/v/4rz56EHfm3w

افتح ملف الإكسيل المراد إدراج فيديو اليوتيوب فيه ، ثم قم بالذهاب للتبويب Developer وانقر على Design Mode أي وضع التصميم ، ثم اختر More Controls ثم قم بإدراج Shockwave Flash Object

بعد رسم الأداة على ورقة العمل ، قم بعمل كليك يمين ثم اختر الأمر Properties

الصق العنوان الذي تم تعديله في الخاصية Movie في نافذة الخصائص Properties

وإليكم ملف مرفق مطبق فيه الخطوات التي تم سردها

تحميل الملف من هنا

إعداد / ياسر خليل أبو البراء

كود طباعة صفحات محددة Select Printer & Print Specific Sheets

السلام عليكم ورحمة الله وبركاته

أقدم لكم كود يمكنك من طباعة صفحات محددة في المصنف ، كما يمكنك تحديد عدد النسخ المراد طباعتها ، كما يمكنك تحديد نوع الطابعة المراد الطباعة عليها

أي أنه ببساطة يمكنك طباعة أوراق عمل محددة حسب الاختيار مع إمكانية اختيار الطابعة وعدد النسخ

سأترك لكم الصور لمعرفة كيفية التعامل مع الكود 

وإليكم الكود المستخدم لتنفيذ الفكرة

Sub PrintSelectedSheets()
    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
    Dim Cnt As Integer
    Dim X As String
    
    Application.Dialogs(xlDialogPrinterSetup).Show
    
    Application.ScreenUpdating = False
        If ActiveWorkbook.ProtectStructure Then
            MsgBox "المصنف محمي", vbCritical
            Exit Sub
        End If
    
        Set CurrentSheet = ActiveSheet
        X = CurrentSheet.Name
        Set PrintDlg = ActiveWorkbook.DialogSheets.Add
        SheetCount = 0
    
        TopPos = 40
        For I = 1 To ActiveWorkbook.Worksheets.Count
            Set CurrentSheet = ActiveWorkbook.Worksheets(I)
    
            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
    
        PrintDlg.Buttons.Left = 240
    
        With PrintDlg.DialogFrame
            .Height = Application.Max(68, PrintDlg.DialogFrame.Top + TopPos - 34)
            .Width = 230
            .Caption = "اختر أوراق العمل المراد طباعتها"
        End With
    
        PrintDlg.Buttons("Button 2").BringToFront
        PrintDlg.Buttons("Button 3").BringToFront
    
        Numcop = Application.InputBox("أدخل عدد النسخ للطباعة:", "كم عدد النسخ?", 1, Type:=1)
        If Numcop = 0 Then
        ElseIf Len(Numcop) > 0 Then
        End If
    
        CurrentSheet.Activate
    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
                    Else
                        Worksheets(Cb.Caption).Select Replace:=False
                    End If
                    Cnt = Cnt + 1
                End If
            Next Cb
            ActiveWindow.SelectedSheets.PrintOut copies:=Numcop

        End If
    Else
        MsgBox "كل أوراق العمل فارغة", 64
    End If

    Application.DisplayAlerts = False
    PrintDlg.Delete

    Sheets(X).Select
End Sub

تحميل الملف من هنا

إعداد / ياسر خليل أبو البراء