در مقاله‌های پرزنتیشن پاورپوینت بصورت خودکار(بخش یکم) و پرزنتیشن پاورپوینت بصورت خودکار(بخش دوم) از یک فایل اکسل که داده‌های خام را شامل میشد، اقدام به استخراج داده‌های مورد نیاز کردیم سپس با ساخت یک فایل پاورپوینت( به‌عنوان یک فایل تمپلیت Template)، نمودارهای اولیه مورد نیازمان را تهیه‌کردیم وبا استفاده از کد‌های VBA توانستیم سه روتین برای اتصال و قطع اتصال به اکسل و همچنین نحوه انتقال اطلاعات از یک فایل اکسل به فایل اکسلی دیگر را تهیه نمودیم. از این پس با نحوه ایجاد یک اسلاید جدید از روی اسلایدهای تمپلیت آشنا شده، سپس خواهیم‌دید چطور می‌توان به داده‌های هر نمودار دسترسی داشت، همچنین چگونه باید با اکسل تعامل کرد تا آن داده‌ای را که نیاز داریم را در اختیار ما قراردهد و در نهایت با برقرار ارتباط میان داده‌های اکسل با نمودار مورد نظرمان خواهیم‌توانست پرزنتیشن مورد نظر را تهیه‌نماییم. شاید در نگاه نخست این‌کار ساده بنظر برسد اما خواهیم دید، تهیه این پاورپوینت نه تنها ساده نیست بلکه پیچیدگی خاص خود را دارد، اما پس از این مراحل دیگر ساخت گزارش‌های مشابه چندان پیچیده نخواهدبود و شما به راحتی خواهید توانست هر گزارشی(منظور پرزنتیشن پاورپوینت می‌باشد) را با یک کلیک تهیه نمایید.

نخست باید بتوان یک اسلاید(از اسلایدهای تمپلیت را برای ایجاد مجدد یک کپی از آن یافت)، کد زیر را در ماژول پاورپوینت وارد کنید:

Function FindSlideByTitlePlaceholder(slideTitle As String) As Slide
    Dim sld As Slide
    Dim shp As Shape

    For Each sld In ActivePresentation.Slides
        If sld.Shapes.Count > 0 Then
            If sld.Shapes(1).Type = msoPlaceholder Then
                If sld.Shapes(1).PlaceholderFormat.Type = ppPlaceholderTitle Then
                    If Trim(sld.Shapes(1).TextFrame.TextRange.Text) = Trim(slideTitle) Then
                        Set FindSlideByTitlePlaceholder = sld
                        Exit Function
                    End If
                End If
            End If
        End If
    Next sld

    Set FindSlideByTitlePlaceholder = Nothing
End Function

این تابع یک اسلاید را براساس محتوای درون تایتل آن میآبد،

• خط 5: حلقه For Each تمامی اسلایدها را برای یافتن اولین اسلاید با تایتل خواسته شده بررسی می‌کند(توجه کنید در اکثر اسلایدهای درون پاورپوینت‌ آیتم شماره یک تایتل می‌باشد)،
• خط 6و7و8: بررسی می‌کند آیا اسلاید شامل اشیا(Shapes) می‌باشد، آیا شی نخستین(Shapes(1)) از نوع msoPlaceholder می‌باشد و درنهایت آیا Shapes(1).PlaceholderFormat.Type از نوع ppPlaceholderTitle می‌باشد(این‌ها همگی در پاورپوینت باید کنترل گردند)
• خط 9: بررسی این‌که آیا تایتل اسلاید با تایتل مورد نطرمان یکی است یا خیر.

حال باید از اسلاید یافت شده یک کپی ایچاد کرده و به انتهای اسلایدهای‌مان اضافه کنیم:

Function DuplicateSlideToEnd(ByVal sourceSlide As Slide) As Slide

    On Error GoTo ErrorHandler
    Dim newSlide As Slide
    Set newSlide = sourceSlide.Duplicate(sourceSlide.SlideIndex)
    newSlide.MoveTo sourceSlide.Application.ActivePresentation.Slides.Count
    Set DuplicateSlideToEnd = newSlide
    Exit Function
 
ErrorHandler:
    MsgBox "Create new slide error: " & Err.Description, vbExclamation
    Set DuplicateSlideToEnd = Nothing
End Function

• خط 5: از اسلایدمان یک کپی جدید ایجاد می‌کند
• خط 6: اسلاید جدید را به انتها منتقل می‌کند.

برای جلوگیری از بزرگ شدن کد یک تابع ایجاد می‌کنیم که داده‌های نمودارمان را تنظیم کند(:

Function SetSlideData(prnSlide As Slide, objChart As Chart, rngSource As Excel.Range, rngDest As Excel.Range, Optional bolTranspose As Boolean = False, Optional strTitle As String = "")
    prnSlide.Shapes.Title.TextFrame.TextRange.Text = strTitle
    Set chartDataSheet = objChart.ChartData.Workbook.Sheets(1)
    TransferData rngSource, rngDest, bolTranspose
    objChart.ChartData.Workbook.Close True
    SetSlideData = True
End Function

• خط 2: تایتل اسلاید را مشخص‌می‌کند
• خط 3: اکسل شیت مرتبط با داده‌های چارت را مشخص‌می‌کند
• خط 4: داده‌ها را انتقال می‌دهد.
• خط 5: بستن اکسل شیت چارت.

پیش از اینکه آخرین روتین را توضیح دهیم برای اینکه روتین آخری پردازنده کامپیوتر را بشدت درگیر می‌کند و در واقع با اجرای آن بقیه کارها مختل می‌گردد لازم است کاری کنیم تا بتوان به بقیه کارهای‌مان در زمان تولید پاورپوینت رسید، کد زیر را به ابتدای Module اضافه کنید:

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

دستور Sleep یک دستور درون ویندوزی می‌باشد که با فراخوان آن به هرمیزان بخواهید می‌توانید اجرای یک روتین را متوقف کنید(مقدار به میلی‌ثانبه) و آخرین روتین که وظیفه آن ساخت تمامی اسلایدهای مرتبط با محصولات‌مان است(میزان سفارش و میزان فروش):

Sub TransferDataToPowerPointChart()
    On Error GoTo ErrorHandler

    Dim baseDataSheet As Worksheet
    Dim reportProductSheet As Worksheet
    
    Dim orderSourceSlide As Slide
    Dim newOrderSlide As Slide
    Dim saleSourceSlide As Slide
    Dim newSaleSlide As Slide
    Dim chartShp As Shape
    Dim chartObj As Chart
    Dim chartDataSheet As Worksheet

    Set orderSourceSlide = FindSlideByTitlePlaceholder("Order of")
    If orderSourceSlide Is Nothing Then
        GoTo ErrorHandler
    End If
    Set saleSourceSlide = FindSlideByTitlePlaceholder("Sale of")
    If saleSourceSlide Is Nothing Then
        GoTo ErrorHandler
    End If

    Call ConnectToExcel
    If excelWorkbook Is Nothing Then
        GoTo ErrorHandler
    End If

    excelApp.Calculation = xlManual
    Set baseDataSheet = excelWorkbook.Sheets("BaseData")
    Set reportProductSheet = excelWorkbook.Sheets("ReportProduct")
    Dim productCode As String
    Dim iRow As Integer
    Dim baseLastRow As Integer
    baseLastRow = baseDataSheet.Cells(baseDataSheet.Rows.Count, "B").End(xlUp).Row
    For iRow = 2 To baseLastRow
        productCode = baseDataSheet.Range("B" & iRow).Value
        reportProductSheet.Range("A1").Value = productCode
        reportProductSheet.Calculate

        lineChartLastRow = reportProductSheet.Cells(reportProductSheet.Rows.Count, "B").End(xlUp).Row
        pieChartLastRow = reportProductSheet.Cells(reportProductSheet.Rows.Count, "H").End(xlUp).Row

        Set newOrderSlide = DuplicateSlideToEnd(orderSourceSlide)
        newOrderSlide.Select
        Application.Caption = productCode & " (" & (iRow - 1) & "/" & (baseLastRow - 1) & ")"
        DoEvents
        Sleep (200)
        Set chartShp = newOrderSlide.Shapes("QOTrend")
        If chartShp.HasChart Then
            Set chartObj = chartShp.Chart
            Set chartDataSheet = chartObj.ChartData.Workbook.Sheets(1)
        Else
            GoTo ErrorHandler
        End If
        SetSlideData newOrderSlide, chartObj, reportProductSheet.Range("B1:C" & lineChartLastRow), chartDataSheet.Range("A1"), , newOrderSlide.Shapes.Title.TextFrame.TextRange.Text & productCode
        
        Set chartShp = newOrderSlide.Shapes("QOCountries")
        If chartShp.HasChart Then
            Set chartObj = chartShp.Chart
            Set chartDataSheet = chartObj.ChartData.Workbook.Sheets(1)
        Else
            GoTo ErrorHandler
        End If
        SetSlideData newOrderSlide, chartObj, reportProductSheet.Range("H1:I" & lineChartLastRow), chartDataSheet.Range("A1"), , newOrderSlide.Shapes.Title.TextFrame.TextRange.Text & productCode




        lineChartLastRow = reportProductSheet.Cells(reportProductSheet.Rows.Count, "E").End(xlUp).Row
        pieChartLastRow = reportProductSheet.Cells(reportProductSheet.Rows.Count, "K").End(xlUp).Row

        Set newSaleSlide = DuplicateSlideToEnd(saleSourceSlide)
        If newSaleSlide Is Nothing Then GoTo ErrorHandler
        newSaleSlide.Select
        Set chartShp = newSaleSlide.Shapes("QOTrend")
        If chartShp.HasChart Then
            Set chartObj = chartShp.Chart
            Set chartDataSheet = chartObj.ChartData.Workbook.Sheets(1)
        Else
            GoTo ErrorHandler
        End If
        SetSlideData newSaleSlide, chartObj, reportProductSheet.Range("E1:F" & pieChartLastRow), chartDataSheet.Range("A1"), , newSaleSlide.Shapes.Title.TextFrame.TextRange.Text & productCode

        Set chartShp = newSaleSlide.Shapes("QOCountries")
        If chartShp.HasChart Then
            Set chartObj = chartShp.Chart
            Set chartDataSheet = chartObj.ChartData.Workbook.Sheets(1)
        Else
            GoTo ErrorHandler
        End If
        SetSlideData newSaleSlide, chartObj, reportProductSheet.Range("K1:L" & pieChartLastRow), chartDataSheet.Range("A1"), , newSaleSlide.Shapes.Title.TextFrame.TextRange.Text & productCode


        DoEvents
        Sleep (200)
    Next
    excelWorkbook.Close True

ErrorHandler:
    On Error Resume Next
    If Not excelWorkbook Is Nothing Then excelWorkbook.Close False
    If Not excelApp Is Nothing Then excelApp.Quit
    Set orderSourceSlide = Nothing
    Set newOrderSlide = Nothing
    Set saleSourceSlide = Nothing
    Set newSaleSlide = Nothing

    Set chartDataRange = Nothing
    Set chartDataSheet = Nothing
    Set reportProductSheet = Nothing
    Set baseDataSheet = Nothing
    Set excelWorkbook = Nothing
    Set excelApp = Nothing
End Sub

خط‌های 4 تا 13: به ترتیب متغیرهای زیر را برای استفاده در برنامه معرفی می‌کند

• baseDataSheet: شیتbaseData  اکسل
• reportProductSheet: شیت reportProduct اکسل
• orderSourceSlide: تمپلیت اسلاید سفارش را مشخص می‌کند
• newOrderSlide: اسلاید جدید ساخته شده از روی orderSourceSlide را مشخص می‌کند
• saleSourceSlide: تمپلیت اسلاید فروش را مشخص می‌کند
• newSaleSlide:  اسلاید جدید ساخته شده از روی saleSourceSlide را مشخص می‌کند
• chartShp: شکل یا شی مرتبط با یک چارت را مشخص می‌کند(توجه کنید تمامی اشیا درون یک اسلاید پاورپوینت یک شکل Shape هستند ویک شکل خود می‌تواند چارت(نمودار) و یا تایتل و یا جدول(Table) باشد(شکل زیر).
• chartObj: خود نمودار درون chartShp را مشخص می‌کند.
• chartDataSheet: اکسل شیت مرتبط با نمودار را مشخص می‌کند.

1. خط 15: اسلایدی را که تایتل آن Order of می‌باشد را پیدا می‌کند(این اسلاید چون ار ابتدا جستجوی می‌گردد حتما اسلاید تمپلیت می‌باشد)
2. خط 19: اسلایدی را که تایتل آن Sale of می‌باشد را پیدا می‌کند.
3. خط 24: اتصال به اکسل فایل اصلی که داده‌ها درون آن قراردارد.
4. خط 29: تنظیم محاسبه درون فایل اکسل به صورت دستی(جهت جلوگیری از کندی برنامه)
5. خط 30و31: تنظیم متغیرهای مرتبط با شیت‌های اکسل
6. خط 35: پیدا کردن آخرین ردیف در ستون B شیت BaseData درون اکسل(این ستون کد تمام محصولات را دارد)
7. خط 36: ایجاد حلقه‌ای برای تمام محصولات(توجه کنید این حلقه از 2 شروع می‌گردد)
8. خط 37: دریافت کدمحصول به ترتیب از ردیف دوم تا ردیف انتها(تمامی محصولات).
9. خط 38: قراردادن کد محصول در شیت گزارش(reportProduct).
10. خط 39: از آنجایی که با تغییر سلول A1 در شیت reportProduct از فایل اکسل‌مان باید تمام فرمول‌ها مجدد محاسبه شوند و ما در خط 29 گفتیم این کار بصورت دستی خواهدبود لذا در این خط محاسبه‌ها فرمول‌ها انجام می‌گردد.
11. خط‌های 41و42: از آنجایی که پس از محاسبه فرمول‌ها تعداد ردیف‌های محصولات ممکن است متفاوت باشد برای هر دو نمودار (خطی Line و نمودار Pie) آخرین ردیف‌ها برای نمایش را پیدامی‌کند.
12. خط 45 تا 48: اختیاری بوده ولی اگر دو خط 47و48 را قرار ندهید موقع تولید پاورپوینت کل سیستم دراختیار برنامه خواهد بود و تقریبا کل سیستم قفل می‌گردد. خط 46 برای آن است که بفهمیم در حال تهیه کدام محصول هستیم و چند محصول دیگر باقی مانده است.
13. خط 49: چارت با نام QOTrend را درون اسلایدمان پیدا می‌کند(در واقع همان نمودار خطی).
14. خط 52: اکسل شیت نمودار خطی ما را مشخص می‌کند.
15. خط 56: داده‌ها را از اکسل اصلی به اکسل نمودار منتقل می‌نماید.
16. بقیه کد به نوعی تکرار کدهای بالا برای نمودار Pie و اسلاید Sale of و نمودارهای داخل آن می‌باشد(تحلیل این بخش به عهده خواننده].
17. از خط 101 تا پایان روتین برای آزادسازی حافظه می‌باشد.

حال برای اجرای برنامه کافی است در همان محیط برنامه نویسی و درون تابع TransferDataToPowerPointChart دکمه F5 را فشاردهید، سپس به تماشای تولید محتوای درون پاورپوینت بپردازید.

•  اکسل (166.1 کیلو بایت)
•  پاورپوینت (125.42 کیلو بایت)