2013-04-29 61 views
-1

我在想,是否可以自動從多個exel文件中提取數據,繪製圖形並最終使用預先存在的模板在pointpoint中呈現數據。我試過Python,但可以去遠,現在有人建議使用VB。我會很感激你的幫助。 這裏是我的數據庫看起來像將數據從excel文件轉換爲電源點

    包含Excel中使用名稱的下面樣式文件
  1. 多個目錄 DIR_1/paint_for_yard1/Blue_light_b2.xls DIR_1/paint_for_yard1/Red_light_b3.xls DIR_1/pat_for_yard8/Green_light_b2.xls 有是在每個目錄下的多個文件,幷包含三列(顏色顏色,日運行時間,夜間運行時間)的許多數據
  2. 我有一個power-point模板,需要根據以下格式的excel文件 第二頁(封頁後)應該包含以下內容e header paint_for_yard1:Blue_light

    在頁面的主體中:當day_run_time最小時,有表格給出了最大day_run_time和pigment_color。 然後在同一頁面上創建顏料顏色,日運行時間,夜間運行時間圖表。

  3. 對每個文件執行步驟2並在功率點中添加頁面。

因爲我不是軟件專家,我不確定Python或VB或組合是否會幫助我。 任何建議將不勝感激。

感謝 阿尼爾

回答

1

幾乎所有的 '成長' 的編程語言可以這樣。所以... C#/ VB.NET/Python可以爲你解決這個問題。

我想我會去PowerPoint模板中的VBA腳本。 VBA是專爲Office製作的,它可以與Excel進行通信。

0

我使用follow Sub從Excel文件創建PowerPoint演示文稿。

Sub Gera_PPT(PFile As String, EFile As String, Plans As Collection) 
'officevb.com 
'PFile= PowerPoint Template empty powerPoint with Slide Master to presentation 
'EFile = Excel File with Charts and Tables 
'Plans = A collection with names of sheets to transpose 
Dim rg As Range 
'objetos usados para o powerpoint 
Dim pptA As Object 
Dim ppt As Object 
Dim sld As Object 

Debug.Print "passei 1" 


If Not ValidaCaminho(PFile) Then 
    MsgBox "PowerPoint file not found!", vbInformation 
    Exit Sub 
Else 
    Set pptA = CreateObject("PowerPoint.Application") 
    pptA.Visible = msoCTrue 
    'pptA.WindowState = -1 
    Set ppt = pptA.Presentations.Open(PFile) 
End If 

'objetos usados para o Excel 
Dim ExA As Excel.Application 
Dim wb As Excel.Workbook 
Dim sht As Excel.Worksheet 


If Not ValidaCaminho(EFile) Then 
    MsgBox "Excel file not found!!", vbInformation 
    Exit Sub 
Else 
    Set ExA = New Excel.Application 
    'ExA.Visible = True 
    Set wb = Workbooks.Open(EFile, False) 
End If 

Debug.Print "passei 2" 

'For Each sht In wb.Sheets 
For i = 1 To Plans.Count 

Set sht = wb.Sheets(Plans(i)) 

    Select Case Left(sht.Name, 1) 

    'Debug.Print "passei 3" 
    'case is Table 
    Case "T" 
      Set sld = ppt.Slides.AddSlide(ppt.Slides.Count + 1, ppt.SlideMaster.CustomLayouts(2)) 
      sld.Select 
      sld.Shapes.Placeholders(2).Select msoCTrue 

      Set rg = sht.Range("B4").CurrentRegion 
      rg.Copy 
      ppt.Windows(1).View.PasteSpecial ppPasteMetafilePicture 

    Case "G" 
    'Case is 1 Chart 

     If sht.ChartObjects.Count = 1 Then 

       Set sld = ppt.Slides.AddSlide(ppt.Slides.Count + 1, ppt.SlideMaster.CustomLayouts(2)) 
       sld.Select 
       sld.Shapes.Placeholders(2).Select msoCTrue 

       sht.ChartObjects(1).Copy 

       ppt.Windows(1).View.PasteSpecial ppPasteMetafilePicture 

'    sld.Shapes.Placeholders.Item(1).TextFrame.TextRange.Text = sht.[A2] 
     Else 
     'Case is >1 Chart 
       Set sld = ppt.Slides.AddSlide(ppt.Slides.Count + 1, ppt.SlideMaster.CustomLayouts(4)) 
       sld.Select 

       sht.Activate 

       sld.Shapes.Placeholders(1).TextFrame.TextRange.Text = sht.Range("A2").Value 

       sld.Shapes.Placeholders(2).Select msoCTrue 
       sht.ChartObjects(1).Copy 
       ppt.Windows(1).View.PasteSpecial ppPasteMetafilePicture 

       sld.Shapes.Placeholders(3).Select msoCTrue 
       sht.ChartObjects(2).Copy 
       ppt.Windows(1).View.PasteSpecial ppPasteMetafilePicture 

     End If 

    End Select 

Next i 

'Insert LastSlide 
Set sld = ppt.Slides.AddSlide(ppt.Slides.Count + 1, ppt.SlideMaster.CustomLayouts(5)) 

wb.Close False 
ExA.Quit 

Strfile = Split(apoio.[PPTFile], "\") 

ppt.SaveAs YourFilePath & "\" & Split(Strfile(UBound(Strfile)), ".")(0) & "-" & Format(Date, "ddmmyyyy") 

pptA.Quit 

MsgBox "Presentation created!", vbInformation 

End Sub 
相關問題