2

主な問題は、PowerPointテーブルに縮小して合わせるオプションがないことです。

Visual Basicを使用してExcelからPowerPointプレゼンテーションにデータを入力しているので、Excelの機能を利用してセルに合わせて縮小することができます。問題は、情報をPowerPointに貼り付けると、フォントサイズに合わせてポストシュリンクが使用されないことです。現時点で私が残しているオプションは、Excelを使用して縮小し、セルの画像をPowerPointに貼り付けることですが、これにより、後でテーブルを編集することができなくなります。

Excelからフォントサイズに合わせて投稿を縮小する方法がある場合は、PowerPointにデータを入力してフォントサイズを変更できますが、セルのフォントサイズを取得する方法しかわかりません（縮小を反映するように更新されていません）。フィット）。

PowerPointテーブルに合わせて縮小するために使用できるものなら何でも役に立ちます。

編集：質問を入力しているときに、考えられる回避策を考えましたが、機能していないようです。一時的に非表示のTextBoxを作成し、セルと同じサイズに変更し、フォーマットをセルのフォーマットに変更してから、この一時的な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
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 に答える