在单独的PowerPoint幻灯片上放置多个Excel表

时间:2017-01-24 13:37:39

标签: excel vba excel-vba powerpoint powerpoint-vba

我将范围从Excel粘贴到Powerpoint作为表格。

问题是当我粘贴第一个表时,定位工作正常(.Top和.Left)但是我在第一个表之后粘贴的表相对于第一个表定位。

.Top成为桌子左上角和第一张桌子位置的上侧之间的距离(不应该是幻灯片的上侧,应该是这样!)同样的事情发生在.Left (它表示表格左上角和第一个表格左侧之间的距离)。

代码如下:

Sub ExportaraPowerPoint()

Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptShape As PowerPoint.Shape
Dim excelTable As Excel.Range
Dim SlideTitle As String
Dim SlideText As String
Dim SlideObject As Object
Dim pptTextbox As PowerPoint.Shape
Dim SlideNumber As String
Dim xlTable As PowerPoint.Shape

'Check is PPT is open and create if not
On Error Resume Next
Set pptApp = GetObject("", "PowerPoint.Application")
Err.Clear
If pptApp Is Nothing Then Set pptApp = CreateObject(class:="PowerPoint.Application")
pptApp.Visible = True
pptApp.Activate

'Add presentation
Set pptPres = pptApp.Presentations.Add
pptPres.PageSetup.SlideSize = ppSlideSizeOnScreen
pptPres.ApplyTemplate "c:\Program Files\Microsoft Office\Templates\1033\Blank.potx"

'Assing Tables
Set excelTable1 = Worksheets("TDSACI").Range("N246:U259")
Set excelTable2 = Worksheets("TDCSD").Range("N215:U223")

'Slide 1:
Set pptSlide = pptPres.Slides.Add(1, ppLayoutTitleOnly)
excelTable1.Copy
pptSlide.Shapes.PasteSpecial (ppPasteDefault)
pptSlide.Shapes(2).Width = 670.4
pptSlide.Shapes(2).Height = 292
pptSlide.Shapes(2).Left = 24.4
pptSlide.Shapes(2).Top = 90.4

'Slide 2:
Set pptSlide = pptPres.Slides.Add(2, ppLayoutTitleOnly)
excelTable2.Copy
pptSlide.Shapes.PasteSpecial (ppPasteDefault)
pptSlide.Shapes(2).Width = 670.4
pptSlide.Shapes(2).Height = 292
pptSlide.Shapes(2).Left = 24.4
pptSlide.Shapes(2).Top = 90.4

我知道表格总是形状索引编号2,所以这不是问题。

根据数字,两个表的位置应该相同。

2 个答案:

答案 0 :(得分:1)

好奇。如果你注释 On Error Resume Next ,请确保选项中的VBE设置为中断所有错误,请稍等首先滑动2行,您将看到代码在.PasteSpecial行之后退出,但没有生成错误。我认为这是因为PowerPoint抱怨幻灯片2不在视图中,所以即使对象似乎粘贴在幻灯片上,粘贴方法也会搞砸!我通过添加GotoSlide方法在我的演示板(PowerPoint 2016)上修复它:

'Slide 2:
Set pptSlide = pptPres.Slides.Add(2, ppLayoutTitleOnly)
excelTable2.Copy
pptApp.ActiveWindow.View.GotoSlide 2
pptSlide.Shapes.PasteSpecial (ppPasteDefault)
pptSlide.Shapes(2).Width = 670.4
pptSlide.Shapes(2).Height = 292
pptSlide.Shapes(2).Left = 24.4
pptSlide.Shapes(2).Top = 90.4

如果代码在PowerPoint VBE中运行,则无需操作PowerPoint视图就可以将对象粘贴到幻灯片上,因此我不确定在这种情况下出了什么问题。

答案 1 :(得分:0)

如果您要处理超过2个范围,以下代码从 public class DeleteRow { public static void main(String[] args) { System.setProperty("hadoop.home.dir", "C:\\winutils"); JavaSparkContext sc = new JavaSparkContext(new SparkConf().setAppName("JoinFunctions").setMaster("local[*]")); SQLContext sqlContext = new SQLContext(sc); SparkSession spark = SparkSession.builder().appName("JavaTokenizerExample").getOrCreate(); List<Row> data = Arrays.asList( RowFactory.create(1,"Hi I heard about Spark"), RowFactory.create(2,"I wish Java could use case classes"), RowFactory.create(3,"Logistic,regression,models,are,neat")); StructType schema = new StructType(new StructField[] { new StructField("label", DataTypes.IntegerType, false, Metadata.empty()), new StructField("sentence", DataTypes.StringType, false, Metadata.empty()) }); String ins = data.get(1).toString(); System.out.println(ins); Dataset<Row> sentenceDataFrame = spark.createDataFrame(data, schema); sentenceDataFrame.drop(data.get(1).toString()); 向下替换可能会更好(并且更具可扩展性)。

'Assing tables