Динамический код Excel VBA для изменения размера текстового поля - PullRequest
Новая
       16

Динамический код Excel VBA для изменения размера текстового поля

0 голосов
/ 05 февраля 2019

Сейчас я работаю над автоматизацией «слайдов презентации PowerPoint» из данных Excel.В соответствии с требованием, я должен создать «динамический код», который может обновлять «Заголовок» слайда, однако, имея в виду, что если текст достаточно большой , то «высота» блокадолжно быть double и «размещение» поля должно быть изменено .

В соответствии с моим пониманием, я попробовал логику «Длина» текста, а затемизмените поля 'height' и 'location' соответственно.

Выдержки из моего Excel VBA кода 

Dim powApp As PowerPoint.Application
Dim powPres As PowerPoint.Presentation
Dim powSlide As PowerPoint.Slide

Set powApp = New PowerPoint.Application
Set powSlide = powPres.Slides(2)
Set powShape = powSlide.Shapes(3)

'cell W7 contains the length of the text of the Title
    If Sheets("sht1").Range("W7").Value > 45 Then
        With powShape
        .Top = 13
        .Height = 57.5
        End With
    ElseIf Sheets("sht1").Range("W7").Value <= 45 Then
        With powShape
        .Top = 20
        .Height = 32
        End With
    End If

Но проблема с этимкод состоит в том, что если у нас есть такие символы (в тексте заголовка), которые занимают больше места, однако не увеличивают длину, например, «M» или «W» (и наоборот для символа «I» или «T» и т. д.),Наличие большего количества этих символов автоматически переходит на следующую строку.

Например:

  1. ITMS% в 2016 году. Показатели продаж составили> 50%

В идеале 1 и 2 должны быть в одной строке тайтла, так как они оба имеют len <45, но так как W, M, W иX занимает больше места. 2-й текст автоматически смещается на следующую строку, но высота блока и его размещение отсутствуют. </p>

Так что мой код не полностью динамический или автоматический: (* ​​1032 *

Впредь, не могли бы вы предложитькод, через который высота и размещение изменяются более подходящим образом

1 Ответ

0 голосов
/ 05 февраля 2019

Существует способ измерить ширину текстового фрейма - это не то же самое, что измерение ширины текстовой строки.В прошлом я делал временную текстовую рамку, заполнял ее нужным шрифтом и измерял ее ширину.Вот пример кода, который вы можете использовать в соответствии со своими потребностями.

В зависимости от ширины текстового фрейма, включая ваш текст, вы можете настроить размер фрейма в вашем коде. 

Option Explicit

Sub test()
    Dim width As Long
    width = MeasureTextFrame("Here Is My Test Title Which Might be Really Long", isBold:=True)
    Debug.Print "text box width is " & width
    width = MeasureTextFrame("Here Is Another Title That's Shorter", isBold:=True)
    Debug.Print "text box width is " & width
End Sub

Public Function MeasureTextFrame(ByVal inputText As String, _
                                 Optional ByVal thisFont As String = "Arial", _
                                 Optional ByVal thisSize As Long = 14, _
                                 Optional ByVal isBold As Boolean = False) As Double
    Dim thisPPTX As Presentation
    Set thisPPTX = ActivePresentation

    '--- create a temporary slide for our measurements
    Dim thisSlide As Slide
    Dim thisLayout As CustomLayout
    Set thisLayout = thisPPTX.Slides(1).CustomLayout
    Set thisSlide = thisPPTX.Slides.AddSlide(thisPPTX.Slides.Count + 1, thisLayout)

    Dim thisFrame As TextFrame
    Set thisFrame = thisSlide.Shapes.AddShape(msoShapeRectangle, 0, 0, 100, 100).TextFrame
    With thisFrame
        .WordWrap = msoFalse
        .AutoSize = ppAutoSizeShapeToFitText
        .TextRange.Text = inputText
        .TextRange.Font.Name = thisFont
        .TextRange.Font.Size = thisSize
        .TextRange.Font.Bold = isBold
    End With

    '--- return width is in points
    MeasureTextFrame = thisFrame.Parent.width

    '--- now delete the temporary slide and frame
    thisSlide.Delete
End Function
...