Построение диаграмм в Excel из данных из Access для размещения в Powerpoint - PullRequest
Новая
       12

Построение диаграмм в Excel из данных из Access для размещения в Powerpoint

0 голосов
/ 27 января 2019

Новичок в сообществе VBA, поэтому, пожалуйста, прости меня, если это не правильный способ решить мою проблему.Я использую Access, Excel и Powerpoint '16.У меня проблемы с каким-то кодом, с которым я играл.Этот процесс происходит через Access, форма с кнопкой будет использоваться для создания презентации PowerPoint.Текст в PowerPoint остается прежним, но у меня есть графики, которые будут произведены при создании следующей презентации.Графики управляются данными в базе данных.Я создаю эти диаграммы в Excel.Я построил этот код в разделах и прошел через каждый раздел без проблем.Когда я собираю весь код вместе, код выполняет процесс без ошибок;однако первая диаграмма, созданная в Excel, вставляется во все позиции диаграммы в PowerPoint.Итак, у меня есть куча дублирующих графиков.Ниже вы найдете часть кода, с которым я работаю, для создания первого графика.Когда я выполняю второй процесс построения диаграммы, он строит диаграмму, но не копирует ее.Это как буфер обмена не обновляется с новым скопированным изображением. 

Private Sub Command30_Click()

'   Powerpoint
    Dim ppApp As PowerPoint.Application
    Dim ppPres As PowerPoint.Presentation
    Dim ppslide As PowerPoint.slide

'    Excel
    Dim excelapp As Excel.Application
    Dim excelwkb As Excel.Workbook
    Dim excelsht As Excel.Worksheet

'    Access
    Dim rst As Recordset

    Set ppApp = New PowerPoint.Application
    ppApp.Visible = True
    ppApp.Activate
    Set ppPres = ppApp.Presentations.Add

        With ppPres
        .PageSetup.SlideSize = 2
        End With

'    SLIDE 7
Set ppslide = ppPres.Slides.Add(1, ppLayoutTitleOnly)

ppslide.Shapes(1).Width = 720
ppslide.Shapes(1).Top = 20
ppslide.Shapes(1).Left = 0

ppslide.Shapes(1).TextFrame.TextRange = "Same old Text"

    With ppslide.Shapes(1).TextFrame
    .TextRange.ParagraphFormat.Alignment = ppAlignCenter
    .TextRange.Font.Size = 28
    .TextRange.Font.Name = tahoma
    .TextRange.Font.Bold = msoTrue
    .TextRange.Font.Color = RGB(0, 0, 205)
    .VerticalAnchor = msoAnchorTop
    End With

ppslide.Shapes.AddTextbox msoTextOrientationHorizontal, 18, 420, 658.8, 425.52
ppslide.Shapes(2).TextFrame.TextRange = "Some more old Text"

    With ppslide.Shapes(2).TextFrame
    .TextRange.ParagraphFormat.Alignment = ppAlignLeft
    .TextRange.Font.Size = 12
    .TextRange.Font.Name = tahoma
    .TextRange.Font.Bold = msoTrue
    .VerticalAnchor = msoAnchorTop
    End With

'        Step into Excel to make Chart

    Set rst = Application.CurrentDb.OpenRecordset("qrydatabase1")
    Set excelapp = CreateObject("excel.application")
    Set excelwkb = excelapp.Workbooks.Add
    Set excelsht = excelwkb.Worksheets.Add

    excelapp.Visible = False

    With excelsht
    .Range("A2").CopyFromRecordset rst
    .Name = "DB1"
    .Range("B1").Value = "Items Processed"
    .Range("C1").Value = "Man Hours"
    .Range("D1:D7").Delete
    excelapp.Charts.Add
    .Shapes.AddChart2(201, xlColumnClustered).Select

    ActiveChart.FullSeriesCollection(1).ChartType = xlLine
    ActiveChart.FullSeriesCollection(1).AxisGroup = 2
    ActiveChart.FullSeriesCollection(2).ChartType = xlColumnClustered
    ActiveChart.FullSeriesCollection(2).AxisGroup = 1
    ActiveChart.PlotBy = xlColumns
    ActiveChart.SetElement (msoElementDataTableWithLegendKeys)
    ActiveChart.SetElement (msoElementLegendNone)
    ActiveChart.HasTitle = True
    ActiveChart.ChartTitle.Text = "This is your data"
    ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
    ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Man Hours"
    ActiveChart.Axes(xlValue, xlSecondary).HasTitle = True
    ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Items Processed"
    ActiveChart.Axes(xlValue).MajorGridlines.Delete
    ActiveChart.CopyPicture

    End With

    excelwkb.Close (0)
    excelapp.Quit

'    Back to Powerpoint

ppslide.Shapes.Paste
    With ppslide.Shapes(3)
    .Width = 618.48
    .Left = 110
    .Top = 60
    .Height = 354.96
    End With


'    SLIDE 8


Set ppslide = ppPres.Slides.Add(2, ppLayoutTitleOnly)

ppslide.Shapes(1).Width = 720
ppslide.Shapes(1).Top = 20
ppslide.Shapes(1).Left = 0
ppslide.Shapes(1).TextFrame.TextRange = "Same Old Text"

    With ppslide.Shapes(1).TextFrame
    .TextRange.ParagraphFormat.Alignment = ppAlignCenter
    .TextRange.Font.Size = 28
    .TextRange.Font.Name = tahoma
    .TextRange.Font.Bold = msoTrue
    .TextRange.Font.Color = RGB(0, 0, 205)
    .VerticalAnchor = msoAnchorTop
    End With

ppslide.Shapes.AddTextbox msoTextOrientationHorizontal, 0, 420, 720, 425.52
ppslide.Shapes(2).TextFrame.TextRange = _
"Again with the Same Old Text"    

    With ppslide.Shapes(2).TextFrame
    .TextRange.ParagraphFormat.Alignment = ppAlignLeft
    .TextRange.ParagraphFormat.Bullet.Character = 8226
    .TextRange.Font.Size = 16
    .TextRange.Font.Name = tahoma
    .VerticalAnchor = msoAnchorTop
    End With

'        Step into Excel to make Chart

    Set rst = Application.CurrentDb.OpenRecordset("qrydata2")
    Set excelapp = CreateObject("excel.application")
    Set excelwkb = excelapp.Workbooks.Add
    Set excelsht = excelwkb.Worksheets.Add

    excelapp.Visible = False


    With excelsht
    .Range("A2").CopyFromRecordset rst
    .Name = "DB2"
    .Range("B1").Value = "Items Processed"
    .Range("C1").Value = "Man Hours"

    excelapp.Charts.Add

    .Shapes.AddChart2(201, xlColumnClustered).Select

    ActiveChart.FullSeriesCollection(1).ChartType = xlLine
    ActiveChart.FullSeriesCollection(1).AxisGroup = 2
    ActiveChart.FullSeriesCollection(2).ChartType = xlColumnClustered
    ActiveChart.FullSeriesCollection(2).AxisGroup = 1

    ActiveChart.PlotBy = xlColumns
    ActiveChart.SetElement (msoElementDataTableWithLegendKeys)
    ActiveChart.SetElement (msoElementLegendNone)
    ActiveChart.HasTitle = True
    ActiveChart.ChartTitle.Text = "This is more of your data"
    ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
    ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Man Hours"
    ActiveChart.Axes(xlValue, xlSecondary).HasTitle = True
    ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Items Processed"
    ActiveChart.Axes(xlValue).MajorGridlines.Delete
    ActiveChart.copy

    End With

    excelwkb.Close (0)
    excelapp.Quit



'    Back to Powerpoint

ppslide.Shapes.Paste

    With ppslide.Shapes(3)
    .Width = 618.48
    .Left = 110
    .Top = 60
    .Height = 354.96
    End With

Ответы [ 2 ]

0 голосов
/ 03 февраля 2019

Итак, после долгих чтений и проб по ошибке я нашел ответ на свою проблему.Во-первых, я хочу поблагодарить Тима за то, что он открыл мне глаза, спасибо, парень, ты действительно помог мне взглянуть на мой код по-другому, чтобы указать мне правильное направление.Пожалуйста, смотрите исправленный код ниже.

Резюме моих проблем:

Я не ссылался на Excel должным образом.

Причина, по которой копирование и вставка не работали должным образом, заключалась в том, что после создания второй диаграммы и ее копированияэто приложение Excel было сказано закрыть и выйти.Когда это было выполнено, я получил предупреждение Excel с просьбой сохранить, мне пришлось отключить это, чтобы он правильно вставил диаграмму в powerpoint.

Наконец, я в лучшем случае начинающий кодер, и я хочу сказать, что этот код все еще нуждается в очистке, и, как сказал Тим, чтобы сделать более надежный код, я должен и в конечном итоге отберу работу от догадок.первенствует.Когда я сделаю это, я обновлю код на этом форуме.

Private Sub Command30_Click()

'   Powerpoint
Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppslide As PowerPoint.slide

'    Excel
Dim excelapp As Excel.Application
Dim excelwkb As Excel.Workbook
Dim excelsht As Excel.Worksheet

'    Access
Dim rst As Recordset




Set ppApp = New PowerPoint.Application

ppApp.Visible = True
ppApp.Activate

Set ppPres = ppApp.Presentations.Add

    With ppPres
    .PageSetup.SlideSize = 2
    End With


'    SLIDE 7

Set ppslide = ppPres.Slides.Add(1, ppLayoutTitleOnly)

ppslide.Shapes(1).Width = 720
ppslide.Shapes(1).Top = 20
ppslide.Shapes(1).Left = 0

ppslide.Shapes(1).TextFrame.TextRange = "Text"

    With ppslide.Shapes(1).TextFrame
    .TextRange.ParagraphFormat.Alignment = ppAlignCenter
    .TextRange.Font.Size = 28
    .TextRange.Font.Name = tahoma
    .TextRange.Font.Bold = msoTrue
    .TextRange.Font.Color = RGB(0, 0, 205)
    .VerticalAnchor = msoAnchorTop
    End With

ppslide.Shapes.AddTextbox msoTextOrientationHorizontal, 18, 420, 658.8, 425.52
ppslide.Shapes(2).TextFrame.TextRange = "Text"

    With ppslide.Shapes(2).TextFrame
    .TextRange.ParagraphFormat.Alignment = ppAlignLeft
    .TextRange.Font.Size = 12
    .TextRange.Font.Name = tahoma
    .TextRange.Font.Bold = msoTrue
    .VerticalAnchor = msoAnchorTop
    End With

'        Step into Excel to make Chart
    Set rst = Application.CurrentDb.OpenRecordset("qryDB1")
    Set excelapp = CreateObject("excel.application")
    Set excelwkb = excelapp.Workbooks.Add
    Set excelsht = excelwkb.Worksheets.Add

    excelapp.Visible = False

    With excelsht
    .Range("A2").CopyFromRecordset rst
    .Name = "Text"
    .Range("B1").Value = "Items Processed"
    .Range("C1").Value = "Man Hours"
    .Range("D1:D7").Delete
    End With

excelapp.Charts.Add
    excelapp.ActiveChart.FullSeriesCollection(1).ChartType = xlLine
    excelapp.ActiveChart.FullSeriesCollection(1).AxisGroup = 2
    excelapp.ActiveChart.FullSeriesCollection(2).ChartType = xlColumnClustered
    excelapp.ActiveChart.FullSeriesCollection(2).AxisGroup = 1
    excelapp.ActiveChart.PlotBy = xlColumns
    excelapp.ActiveChart.SetElement (msoElementDataTableWithLegendKeys)
    excelapp.ActiveChart.SetElement (msoElementLegendNone)
    excelapp.ActiveChart.HasTitle = True
    excelapp.ActiveChart.ChartTitle.Text = "Text"
    excelapp.ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
    excelapp.ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Man Hours"
    excelapp.ActiveChart.Axes(xlValue, xlSecondary).HasTitle = True
    excelapp.ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Items Processed"
    excelapp.ActiveChart.Axes(xlValue).MajorGridlines.Delete
    excelapp.ActiveChart.CopyPicture

    excelapp.DisplayAlerts = False
    excelwkb.Close savechanges:=False
    excelapp.Quit

'    Back to Powerpoint
ppslide.Shapes.Paste
    With ppslide.Shapes(3)
    .Width = 618.48
    .Left = 110
    .Top = 60
    .Height = 354.96
    End With


'    SLIDE 8

Set ppslide = ppPres.Slides.Add(2, ppLayoutTitleOnly)

ppslide.Shapes(1).Width = 720
ppslide.Shapes(1).Top = 20
ppslide.Shapes(1).Left = 0
ppslide.Shapes(1).TextFrame.TextRange = "Text"

    With ppslide.Shapes(1).TextFrame
    .TextRange.ParagraphFormat.Alignment = ppAlignCenter
    .TextRange.Font.Size = 28
    .TextRange.Font.Name = tahoma
    .TextRange.Font.Bold = msoTrue
    .TextRange.Font.Color = RGB(0, 0, 205)
    .VerticalAnchor = msoAnchorTop
    End With

ppslide.Shapes.AddTextbox msoTextOrientationHorizontal, 0, 420, 720, 425.52
ppslide.Shapes(2).TextFrame.TextRange = "Text"


    With ppslide.Shapes(2).TextFrame
    .TextRange.ParagraphFormat.Alignment = ppAlignLeft
    .TextRange.ParagraphFormat.Bullet.Character = 8226
    .TextRange.Font.Size = 16
    .TextRange.Font.Name = tahoma
    .VerticalAnchor = msoAnchorTop
    End With

'        Step into Excel to make Chart
    Set rst = Application.CurrentDb.OpenRecordset("qryDB2")
    Set excelapp = CreateObject("excel.application")
    Set excelwkb = excelapp.Workbooks.Add
    Set excelsht = excelwkb.Worksheets.Add

    excelapp.Visible = False


    With excelsht
    .Range("A2").CopyFromRecordset rst
    .Name = "Text"
    .Range("B1").Value = "Items Processed"
    .Range("C1").Value = "Man Hours"
    End With

    excelapp.Charts.Add
    excelapp.ActiveChart.FullSeriesCollection(1).ChartType = xlLine
    excelapp.ActiveChart.FullSeriesCollection(1).AxisGroup = 2
    excelapp.ActiveChart.FullSeriesCollection(2).ChartType = xlColumnClustered
    excelapp.ActiveChart.FullSeriesCollection(2).AxisGroup = 1
    excelapp.ActiveChart.PlotBy = xlColumns
    excelapp.ActiveChart.SetElement (msoElementDataTableWithLegendKeys)
    excelapp.ActiveChart.SetElement (msoElementLegendNone)
    excelapp.ActiveChart.HasTitle = True
    excelapp.ActiveChart.ChartTitle.Text = "Text"
    excelapp.ActiveChart.Axes(xlValue, xlPrimary).HasTitle = True
    excelapp.ActiveChart.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Man Hours"
    excelapp.ActiveChart.Axes(xlValue, xlSecondary).HasTitle = True
    excelapp.ActiveChart.Axes(xlValue, xlSecondary).AxisTitle.Characters.Text = "Items Processed"
    excelapp.ActiveChart.Axes(xlValue).MajorGridlines.Delete
    excelapp.ActiveChart.CopyPicture

    excelapp.DisplayAlerts = False
    excelwkb.Close savechanges:=False
    excelapp.Quit


'    Back to Powerpoint
ppslide.Shapes.Paste

    With ppslide.Shapes(3)
    .Width = 618.48
    .Left = 110
    .Top = 60
    .Height = 354.96
    End With

End Sub
0 голосов
/ 28 января 2019 
With excelsht
    .Range("A2").CopyFromRecordset rst
    .Name = "DB1"
    .Range("B1").Value = "Items Processed"
    .Range("C1").Value = "Man Hours"
    .Range("D1:D7").Delete
    excelapp.Charts.Add
    .Shapes.AddChart2(201, xlColumnClustered).Select

Здесь вы добавляете две диаграммы - одну в виде листа диаграммы, а другую в таблицу excelsht - это намеренно?Кто из них становится Activechart?Я бы сделал Excel видимым, чтобы вы могли видеть, что на самом деле происходит.

Кроме того - вы, похоже, полагаетесь на то, что Excel автоматически выбирает данные диаграммы: возможно, это не самый безопасный подход.У вас был бы более надежный код, если вы явно добавите данные в диаграмму после ее создания.

...