Note: The other languages of the website are Google-translated. Back to English

كيفية تصدير المخططات الفردية أو كلها من أوراق عمل Excel إلى PowerPoint؟

في بعض الأحيان ، قد تحتاج إلى تصدير مخطط أو كل المخططات من Excel إلى PowerPoint لبعض الأغراض. هذا المقال يتحدث عن كيفية تحقيق ذلك.

قم بتصدير مخطط واحد أو كل المخططات من ورقة عمل Excel إلى PowerPoint باستخدام كود VBA


قم بتصدير مخطط واحد أو كل المخططات من ورقة عمل Excel إلى PowerPoint باستخدام كود VBA

سيقدم هذا القسم أكواد VBA لتصدير مخطط واحد أو كل المخططات من المصنف إلى PowerPoint. الرجاء القيام بما يلي.

1. اضغط على قديم + F11 مفاتيح معًا لفتح ملفات ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. في ال ميكروسوفت فيسوال باسيك للتطبيقات الإطار، انقر فوق الأدوات > المحلية كما هو موضح أدناه لقطة الشاشة.

3. في ال المراجع - VBAProject مربع الحوار ، قم بالتمرير لأسفل للعثور على ملف مكتبة كائنات Microsoft PowerPoint الخيار ، ثم انقر فوق OK زر. انظر لقطة الشاشة:

4. ثم اضغط إدراج > وحدة.

5. إذا كنت ترغب في تصدير مخطط واحد إلى PowerPoint ، فالرجاء الانتقال إلى تحديد المخطط في ورقة العمل ، ثم العودة إلى ملف ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، انسخ والصق رمز فبا أدناه في نافذة الوحدة النمطية.

كود فبا: تصدير مخطط واحد من ورقة عمل Excel إلى PowerPoint

Sub SingleActiveChartToPowerPoint_EarlyBinding1()
'Updated by Extendoffice 2017/9/15
  Dim pptApp As PowerPoint.Application
  Dim pptPres As PowerPoint.Presentation
  Dim pptSlide As PowerPoint.Slide
  Dim pptShape As PowerPoint.Shape
  Dim pptShpRng As PowerPoint.ShapeRange
  Dim xActiveSlideNow As Long
  On Error Resume Next
  If ActiveChart Is Nothing Then
    MsgBox "Select a chart and try again!", vbExclamation, "KuTools For Excel"
    Exit Sub
  End If
  Set pptApp = GetObject(, "PowerPoint.Application")
  If pptApp Is Nothing Then
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPres = pptApp.Presentations.Add
    Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
  Else
    If pptApp.Presentations.Count > 0 Then
      Set pptPres = pptApp.ActivePresentation
      If pptPres.Slides.Count > 0 Then
        xActiveSlideNow = pptApp.ActiveWindow.View.Slide.SlideIndex
        Set pptSlide = pptPres.Slides(xActiveSlideNow)
      Else
        Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
      End If
    Else
      Set pptPres = pptApp.Presentations.Add
      Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    End If
  End If
  ActiveChart.ChartArea.Copy
  With pptSlide
    .Shapes.Paste
    Set pptShape = .Shapes(.Shapes.Count)
    Set pptShpRng = .Shapes.Range(pptShape.Name)
  End With
  With pptShpRng
    .Align msoAlignCenters, True
    .Align msoAlignMiddles, True
  End With
  pptShpRng.Select
End Sub

إذا كنت ترغب في تصدير جميع المخططات من المصنف ، يرجى نسخ ولصق رمز فبا أدناه في نافذة الوحدة النمطية.

كود فبا: قم بتصدير جميع المخططات من أوراق عمل Excel إلى PowerPoint

Option Explicit
'Updated by Extendoffice 2017/9/15
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer
Sub ChartsToPowerPoint()
    Dim xSheet As Worksheet
    Dim xChartsCount As Integer
    Dim xChart As Object
    Dim xActiveSlideNow As Integer
    On Error Resume Next
    For Each xSheet In ActiveWorkbook.Worksheets
        xChartsCount = xChartsCount + xSheet.ChartObjects.Count
    Next xSheet
    If xChartsCount = 0 Then
        MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
        Exit Sub
    End If
    Set pptApp = GetObject(, "PowerPoint.Application")
    If pptApp Is Nothing Then
      Set pptApp = CreateObject("PowerPoint.Application")
      Set pptPres = pptApp.Presentations.Add
      Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    Else
        If pptApp.Presentations.Count > 0 Then
          Set pptPres = pptApp.ActivePresentation
          If pptPres.Slides.Count > 0 Then
            xActiveSlideNow = pptApp.ActiveWindow.View.Slide.SlideIndex
            Set pptSlide = pptPres.Slides(xActiveSlideNow)
          Else
            Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
          End If
        Else
          Set pptPres = pptApp.Presentations.Add
          Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
        End If
    End If
    For Each xSheet In ActiveWorkbook.Worksheets
        For Each xChart In xSheet.ChartObjects
            Call pptFormat(xChart.Chart)
        Next xChart
    Next xSheet
    For Each xChart In ActiveWorkbook.Charts
        Call pptFormat(xChart)
    Next xChart
    
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "KuTools For Excel"
End Sub
Private Sub pptFormat(xChart As Chart)
    Dim xCharTiTle As String
    Dim I As Integer
    On Error Resume Next
    xCharTiTle = xChart.ChartTitle.Text
    xChart.ChartArea.Copy
    pptSlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
    pptSlide.Select
    pptSlide.Shapes.PasteSpecial ppPasteJPG
    If xCharTiTle <> "" Then
        pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 12.5, 20, 694.75, 55.25
    End If
    For I = 1 To pptSlide.Shapes.Count
        With pptSlide.Shapes(I)
            Select Case .Type
                Case msoPicture:
                    .Top = 87.84976
                    .left = 33.98417
                    .Height = 422.7964
                    .Width = 646.5262
                Case msoTextBox:
                    With .TextFrame.TextRange
                        .ParagraphFormat.Alignment = ppAlignCenter
                        .Text = xCharTiTle
                        .Font.Name = "Tahoma (Headings)"
                        .Font.Size = 28
                        .Font.Bold = msoTrue
                    End With
                End Select
        End With
    Next I
End Sub

6. اضغط على F5 مفتاح أو انقر فوق الزر "تشغيل" لتشغيل التعليمات البرمجية. ثم سيتم فتح PowerPoint جديد مع المخطط المحدد أو استيراد جميع المخططات. وستحصل على ملف كوتولس ل إكسيل مربع الحوار كما هو موضح أدناه لقطة الشاشة ، يرجى النقر فوق OK .


مقالات ذات صلة:


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (7)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرًا لك ، لقد عملت التعليمات البرمجية الخاصة بك على أكمل وجه مع ما أحتاج إلى القيام به. سأضع إشارة مرجعية على صفحتك وأعود عندما أحتاج إلى المزيد.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، شكرًا لك على الرمز.

لقد حاولت تحديث الكود الخاص بك مع بعض التغييرات ولكني لا أعرف كيف يمكنني القيام بذلك ، أحتاج إلى تحديث / تغيير بعض الأشكال على شريحة معينة ، لكنني لا أعرف كيف يمكنني القيام بذلك.؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا أنتوني ،
آسف لا أستطيع مساعدتك في ذلك حتى الآن. شكرا على تعليقك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أهلا،
كيف يمكنني الحصول على بعض الأشياء في PDF؟

شكر !
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،

لقد حاولت تشغيل الكود الخاص بك ، ولكن على الرغم من أنه يلقي بهذه الرسالة ، إلا أنه لا يفتح أي PowerPoint ، دون إلقاء أي خطأ.
يجب أن تكون المخططات في ورقة فريدة ، أو لا توجد مشكلة إذا كانت في ورقة معًا؟

شكر.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا أندرياس،
يمكنك تصدير مخطط واحد عن طريق تحديده وتشغيل الكود الأول.
أو قم بتصدير كافة المخططات الموجودة في المصنف بالرمز الثاني.
شكرا لتعليقك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، الكود الخاص بك مشابه جدًا للرمز الذي قمت به ، لكن لدي سؤال ، كيف يمكنني لصق الرسومات ولكن يمكنني تحرير البيانات في ملف باور بوينت؟
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL