एक आकार फिट करने के लिए पाठ प्राप्त करना

मैंने सोचा कि मैं अपने प्रश्न का उत्तर दूंगा और सूत्र बंद कर दूंगा। बहुत शोध करने के बाद मैंने पाया कि पावरपॉइंट शो चलने पर टेक्स्ट को स्वतः आकार बदलने के लिए कोई स्पष्ट तरीका नहीं था। मैंने कई दृष्टिकोणों की कोशिश की उदा। टेक्स्ट सम्मिलित करना, टेक्स्ट को ट्रिम करना और वर्ड रैप को बंद और चालू करना - हालांकि, इनमें से किसी ने भी काम नहीं किया। मैं ध्यान देता हूं (भावेश) मैं पूरी तरह से जानता था कि पावरपॉइंट के जीयूआई के माध्यम से ऑटो-साइज टेक्स्ट सेटिंग्स का चयन कैसे करें।

अंत में मेरा समाधान डू लूप बनाना और टेक्स्ट का आकार बदलना था।

नीचे मैंने अपनी प्रमुख पंक्तियों को इस उम्मीद में चिपकाया है कि यह किसी और की मदद कर सकता है जो ऐसा करने की कोशिश कर रहा है। मैंने एक चर अतिप्रवाह बनाया है जो यह आकलन करने का प्रयास करता है कि आकृति के टेक्स्टबॉक्स की ऊंचाई आयत के आकार से बड़ी है या नहीं।

Dim overflow As Integer
Dim counter As Integer    

counter = 0

With ActivePresentation.Slides(i).Shapes(stringToTest)
                    
overflow = CInt((.TextFrame.TextRange.BoundHeight) - (.Height - .TextFrame.MarginTop - .TextFrame.MarginBottom))
                    
Do While overflow > 16 And counter < 50
'*** I note that the shape is overflowing when its value is >0 but I found 16 to be the most "aesthetically pleasing" number!
'*** Also using a counter prevents the code from potentially getting stuck in an infinite loop

If .TextFrame.TextRange.Font.Size > 20 Then                                
.TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size - 1
Else
.TextFrame.TextRange.Font.Size = .TextFrame.TextRange.Font.Size - 0.5
End If
'**** By reducing the font size by 0.5 this provided a better fit for the text _
'**** (even better than using on PowerPoint's auto-size function!)

counter = counter + 1
overflow = CInt((.TextFrame.TextRange.BoundHeight) - (.Height - .TextFrame.MarginTop - .TextFrame.MarginBottom))
Loop

End With