从数据在Excel图表号楼进出的放置在简报

问题描述 投票：0回答：2

新的VBA社区，所以请原谅我，如果这不是处理我的问题的正确方法。我利用访问，Excel和PowerPoint '16。我有一些代码，我一直在玩的麻烦。这个过程通过访问发生，有一个按钮的形式将被用来生成一个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
vba charts powerpoint access
2个回答
0
投票
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会自动选择图表数据：这也许不是采取最安全的方法。你必须更加健壮的代码，如果你明确创建后的数据添加到图表。

0
投票

因此，通过错误做大量的阅读和试​​用后，我已经找到了答案，以我的问题。首先，我要感谢蒂姆打开我的眼睛，感谢的人你真的帮我看看我的代码不同点我到正确的方向。请参阅下面的修改后的代码。

我的问题摘要：

我没有引用的Excel正确。

复制和粘贴的原因而不能正常工作了，因为它创造了第二个图表，并将它复制后，Excel应用程序被告知关闭并退出。当这个被处决我收到了Excel警告，询问保存，我不得不禁用此有它正确地贴在图表中的PowerPoint。

最后，我充其量是个新手编码器，我的观点是，这个代码仍需要清理和蒂姆曾表示做出更健壮的代码我应该和最终会从Excel采取了猜测工作了。当我这样做，我会更新这个论坛上的代码。

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
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.