Important
🔔Compatibility of this generator
This generator is written in PowerPoint for Office 365, and the Office series should work properly. Please confirm that your PowerPoint is from the Office series before downloading.
🔔Why is the WPS series not applicable?
According to the WPS usage documentation: If you need to use VBA macro functions, you need to purchase the commercial standard or commercial premium version of WPS; the personal version does not have macro usage rights. For more details, please refer to: How to obtain VBA macro usage rights
🔔Can I share this generator with others?
Yes, this work follows the MIT License.
🔔Usage issues
If you encounter any issues while using it, please leave a message on this page or email to i#mail.vinking.top (replace # with @) for a timely response.
Recently, my girlfriend said she needed to use cloud font to make a PPT for a public class. Something like this:
The basic principle is to copy the text box twice and then adjust the text outlines of those two copies. Finally, align these three text boxes.
After searching online, I found that free tutorials for cloud fonts only teach you how to do it one by one, which is very, very troublesome; while generators require payment, and the preset effects are limited and not very appealing. Later, I created a cloud font generator using the built-in VBA in PPT that allows for more customizable options for her, enabling one-click generation and copying of cloud fonts.
The specific VBA code is as follows, which can be used as a macro in PPT:
Private Sub CommandButton1_Click()
With ActivePresentation.Slides(1)
If IsNumeric(.Shapes("FirstBackgroundColor_R_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("FirstBackgroundColor_G_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("FirstBackgroundColor_B_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("SecondBackgroundColor_R_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("SecondBackgroundColor_G_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("SecondBackgroundColor_B_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("TextColor_R_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("TextColor_G_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("TextColor_B_Box").OLEFormat.Object.Text) _
And IsNumeric(.Shapes("FontSizeBox").OLEFormat.Object.Text) Then
TextBoxValue = .Shapes("TextBox").OLEFormat.Object.Text
FontSizes = .Shapes("FontSizeBox").OLEFormat.Object.Text
FirstBackgroundColor_R = .Shapes("FirstBackgroundColor_R_Box").OLEFormat.Object.Text
FirstBackgroundColor_G = .Shapes("FirstBackgroundColor_G_Box").OLEFormat.Object.Text
FirstBackgroundColor_B = .Shapes("FirstBackgroundColor_B_Box").OLEFormat.Object.Text
SecondBackgroundColor_R = .Shapes("SecondBackgroundColor_R_Box").OLEFormat.Object.Text
SecondBackgroundColor_G = .Shapes("SecondBackgroundColor_G_Box").OLEFormat.Object.Text
SecondBackgroundColor_B = .Shapes("SecondBackgroundColor_B_Box").OLEFormat.Object.Text
TextColor_R = .Shapes("TextColor_R_Box").OLEFormat.Object.Text
TextColor_G = .Shapes("TextColor_G_Box").OLEFormat.Object.Text
TextColor_B = .Shapes("TextColor_B_Box").OLEFormat.Object.Text
If .Shapes("Text").HasTextFrame Then
With .Shapes("Text").TextFrame.TextRange
.Text = TextBoxValue
.Font.Size = FontSizes
.Font.Color.RGB = RGB(TextColor_R, TextColor_G, TextColor_B)
End With
End If
If .Shapes("FirstBackground").HasTextFrame Then
With .Shapes("FirstBackground")
.TextFrame.TextRange.Text = TextBoxValue
.TextFrame.TextRange.Font.Size = FontSizes
With .TextFrame2.TextRange.Font.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(FirstBackgroundColor_R, FirstBackgroundColor_G, FirstBackgroundColor_B)
.Transparency = 0
.Visible = msoTrue
.Weight = 25
End With
End With
End If
If .Shapes("SecondBackground").HasTextFrame Then
With .Shapes("SecondBackground")
.TextFrame.TextRange.Text = TextBoxValue
.TextFrame.TextRange.Font.Size = FontSizes
With .TextFrame2.TextRange.Font.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(SecondBackgroundColor_R, SecondBackgroundColor_G, SecondBackgroundColor_B)
.Transparency = 0
.Visible = msoTrue
.Weight = 50
End With
End With
End If
With .Shapes.Range(Array("Text", "FirstBackground", "SecondBackground"))
.TextFrame.HorizontalAnchor = msoAnchorCenter
.TextFrame.VerticalAnchor = msoAnchorMiddle
.TextFrame.WordWrap = msoTrue
.TextFrame.AutoSize = ppAutoSizeShapeToFitText
.Copy
End With
Else
MsgBox "Please enter numbers in the text size and background color input boxes"
End
End If
End With
End Sub
Private Sub CommandButton2_Click()
With ActivePresentation.Slides(1)
.Shapes("TextBox").OLEFormat.Object.Text = "A"
.Shapes("FontSizeBox").OLEFormat.Object.Text = 60
With .Shapes("Text").TextFrame.TextRange
.Text = "A"
.Font.Size = 60
.Font.Color.RGB = RGB(0, 0, 0)
End With
With .Shapes("FirstBackground")
.TextFrame.TextRange.Text = "A"
.TextFrame.TextRange.Font.Size = 60
With .TextFrame2.TextRange.Font.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 255, 255)
.Transparency = 0
.Visible = msoTrue
.Weight = 25
End With
End With
With .Shapes("SecondBackground")
.TextFrame.TextRange.Text = "A"
.TextFrame.TextRange.Font.Size = 60
With .TextFrame2.TextRange.Font.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(39, 154, 225)
.Transparency = 0
.Visible = msoTrue
.Weight = 50
End With
End With
.Shapes("TextColor_R_Box").OLEFormat.Object.Text = 0
.Shapes("TextColor_G_Box").OLEFormat.Object.Text = 0
.Shapes("TextColor_B_Box").OLEFormat.Object.Text = 0
.Shapes("FirstBackgroundColor_R_Box").OLEFormat.Object.Text = 255
.Shapes("FirstBackgroundColor_G_Box").OLEFormat.Object.Text = 255
.Shapes("FirstBackgroundColor_B_Box").OLEFormat.Object.Text = 255
.Shapes("SecondBackgroundColor_R_Box").OLEFormat.Object.Text = 39
.Shapes("SecondBackgroundColor_G_Box").OLEFormat.Object.Text = 154
.Shapes("SecondBackgroundColor_B_Box").OLEFormat.Object.Text = 225
End With
MsgBox "Initialization complete"
End Sub
If you don't want to do it yourself, here is a complete PPT file for the generator:
123 Cloud Disk (Recommended):
Baidu Cloud Disk (Backup):
This article is synchronized and updated to xLog by Mix Space. The original link is https://www.vinking.top/posts/codes/create-cloud-font-with-vba-in-ppt