缩小到适合的Excel / PowerPoint文本大小

主要的问题是PowerPoint表格没有适合缩小的选项。

由于我使用Visual Basic来从Excel中填充PowerPoint演示文稿，因此我可以利用Excels的缩小function来适应单元格。 问题是，如果我将信息粘贴到PowerPoint中，它不会使用后缩放以适应字体大小。 我现在select的选项是使用Excels缩小到适合，然后将单元格的图像粘贴到PowerPoint中，但是这会消除以后编辑表格的function。

如果有一种方法可以让文章缩小到适合Excel中的字体大小，那么我可以填充PowerPoint并更改字体大小，但是我只知道如何获取单元格的字体大小（未更新以反映缩小到适合）。

任何可以用来缩小以适应PowerPoint表格的东西都是有帮助的。

编辑：当input的问题，我想到一个可能的解决方法，但它似乎并没有工作。 我试图做一个临时隐藏的文本框，重新调整它的大小相同的单元格，更改为单元格的格式，然后启用此临时TextBox溢出收缩。 问题是当我尝试获取文本大小时，它将返回TextBox的原始默认值。

Function getStringShrinkSize(wid As Double, high As Double, txt As String) As Double Set shpCurShape = ActiveWindow.View.Slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, wid, high) shpCurShape.name = "temp1" With shpCurShape .height = high .Width = wid With .TextFrame.TextRange With .Font .Bold = msoTrue .name = "Tahoma" End With End With With .TextFrame2 .WordWrap = True .AutoSize = msoAutoSizeTextToFitShape .TextRange = txt End With End With getStringShrinkSize = ActiveWindow.View.Slide.Shapes("temp1").TextFrame.TextRange.Font.Size End Function Sub testGetStringShrinkSize() Debug.Print ("" & getStringShrinkSize(50, 20, "This is a test")) Debug.Print ("second try: " & ActiveWindow.View.Slide.Shapes("temp1").TextFrame.TextRange.Font.Size) ActiveWindow.View.Slide.Shapes("temp1").Delete End Sub 

Answer 1

这似乎是一个时间问题。 在应用缩小字体大小之前，macros返回。 如果稍后查询字体大小，则会减less。

我可以通过某种忙等待计时器来解决这个问题，请参阅下面的代码。 不完全是一个漂亮的解决scheme，但如果你的代码在批处理模式下运行，时间不是一个问题，它可以为你工作。

 Function getStringShrinkSize(wid As Double, high As Double, txt As String) As Double Set shpCurShape = ActiveWindow.View.Slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, wid, high) With shpCurShape .Height = high .Width = wid With .TextFrame.TextRange.Font .Bold = msoTrue .Name = "Tahoma" ' Set known default font size .Size = 20 End With With .TextFrame2 .AutoSize = msoAutoSizeTextToFitShape .WordWrap = True .TextRange = txt End With End With ' Wait until the reduced text size is applied but no longer than 3 seconds Dim start As Date start = Now Do DoEvents Loop Until shpCurShape.TextFrame2.TextRange.Font.Size <> 20 Or DateDiff("s", start, Now) >= 3 getStringShrinkSize = shpCurShape.TextFrame2.TextRange.Font.Size End Function