2

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

由于我使用 Visual Basic 从 Excel 填充 PowerPoint 演示文稿，因此我能够利用 Excel 的能力来缩小以适应单元格。问题是，如果我将信息粘贴到 PowerPoint 中，它不会使用后期缩小来适应字体大小。我目前剩下的选项是使用 Excel 缩小以适应然后将单元格的图像粘贴到 PowerPoint 中，但这消除了以后编辑表格的能力。

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

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

编辑：在输入问题时，我想到了一种可能的解决方法，但它似乎不起作用。我尝试制作一个临时隐藏的文本框，将其重新调整为与单元格相同的大小，将格式更改为单元格的格式，然后为这个临时文本框启用溢出时收缩。问题是当我尝试获取文本大小时，它返回 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
4

1 回答 1

2

这似乎是一个时间问题。宏在应用减小的字体大小之前返回。如果您稍后查询字体大小，它将被缩小。

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

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
于 2012-07-25T10:04:19.510 回答