축소 후 Excel/PowerPoint 텍스트 크기

Question

주된 문제는 PowerPoint 테이블에 축소 옵션이 없다는 것입니다.

Visual Basic을 사용하여 Excel에서 PowerPoint 프레젠테이션을 채우기 때문에 Excel에 맞게 셀을 축소하는 기능을 사용할 수 있습니다. 문제는 정보를 PowerPoint에 붙여 넣으면 글꼴 크기에 맞게 축소됩니다. 현재 내가 선택한 옵션은 Exels shrink를 사용하여 셀의 이미지를 PowerPoint에 붙여 넣은 다음 나중에 붙여 넣을 수있는 기능을 제거하는 것입니다.

Excel에서 글꼴 크기에 맞게 게시물 축소를 얻는 방법이 있으면 PowerPoint를 채우고 글꼴 크기를 변경할 수 있지만 셀의 글꼴 크기를 가져 오는 방법 만 알고 있습니다 (업데이트되지 않음). 수축을 반영하기 위해).

PowerPoint 테이블에 맞게 축소 할 수있는 모든 것이 유용 할 것입니다.

편집 : 질문을 입력하는 동안 나는 가능한 해결책을 생각했지만 작동하지 않는 것 같습니다. 나는 임시 숨겨진 TextBox를 만들려고했는데, Cell과 같은 크기로 다시 포맷하고 셀의 포맷으로 변경 한 다음이 임시 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

타이밍 문제 인 것 같습니다. 축소 된 글꼴 크기가 적용되기 전에 매크로가 반환됩니다. 나중에 글꼴 크기를 쿼리하면 글꼴 크기가 줄어 듭니다.

나는 일종의 busy-wait 타이머로 이것을 해결할 수있었습니다. 아래 코드를보십시오. 정확하게 정확한 솔루션은 아니지만 코드가 일괄 처리 모드로 실행되고 타이밍이 문제가되지 않으면 문제가되지 않습니다.

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