所以我有了这个宏，它基本上可以扫描 PowerPoint 中的每张幻灯片并设置指定的语言。效果很好。但是，它会跳过不是文本框的容器。我希望它将语言应用于表格、智能艺术、图表等。基本上任何可能包含文本的东西。
这可能吗？这是当前的代码：
Public Sub changeLanguage()
On Error Resume Next
'lang = "English"
lang = "Norwegian"
'Determine language selected
If lang = "English" Then
lang = msoLanguageIDEnglishUK
ElseIf lang = "Norwegian" Then
lang = msoLanguageIDNorwegianBokmol
End If
'Set default language in application
ActivePresentation.DefaultLanguageID = lang
'Set language in each textbox in each slide
For Each oSlide In ActivePresentation.Slides
Dim oShape As Shape
For Each oShape In oSlide.Shapes
oShape.Select
oShape.TextFrame.TextRange.LanguageID = lang
Next
Next
End Sub
是的，这在 PowerPoint 中并不那么直观，但它是可以做到的。基本上，有 3 种主要的形状类型（简单形状、分组形状和表格形状）。此代码将检查所有这些：
Public Sub changeLanguage()
On Error Resume Next
Dim gi As GroupShapes '<-this was added. used below
'lang = "English"
lang = "Norwegian"
'Determine language selected
If lang = "English" Then
lang = msoLanguageIDEnglishUK
ElseIf lang = "Norwegian" Then
lang = msoLanguageIDNorwegianBokmol
End If
'Set default language in application
ActivePresentation.DefaultLanguageID = lang
'Set language in each textbox in each slide
For Each oSlide In ActivePresentation.Slides
Dim oShape As Shape
' Sets the language for the notes page as well.
Dim oShape As Shape
For Each oShape In oSlide.NotesPage.Shapes
oShape.Select
oShape.TextFrame.TextRange.LanguageID = lang
Next
For Each oShape In oSlide.Shapes
'Check first if it is a table
If oShape.HasTable Then
For r = 1 To oShape.Table.Rows.Count
For c = 1 To oShape.Table.Columns.Count
oShape.Table.Cell(r, c).Shape.TextFrame.TextRange.LanguageID = lang
Next
Next
Else
Set gi = oShape.GroupItems
'Check if it is a group of shapes
If Not gi Is Nothing Then
If oShape.GroupItems.Count > 0 Then
For i = 0 To oShape.GroupItems.Count - 1
oShape.GroupItems(i).TextFrame.TextRange.LanguageID = lang
Next
End If
'it's none of the above, it's just a simple shape, change the language ID
Else
oShape.TextFrame.TextRange.LanguageID = lang
End If
End If
Next
Next
End Sub
虽然已经过去了一点时间...来自 https://superuser.com/questions/432366/how-do-i-change-the-language-of-all-powerpoint-slides-at-once 。由于我更喜欢使用 python，因此使用
win32cominfile_name = 'drive:/path/to/in.pptx'
outfile_name = 'drive:/path/to/out.pptx'
target_language = 1031 # find in language list, here German
import time
import win32com.client
ppt = win32com.client.Dispatch('PowerPoint.Application')
ppt.Visible = True
presentation = ppt.Presentations.Open(infile_name)
def change_all_subshapes(target_shape, language_id):
if target_shape.HasTextFrame:
target_shape.TextFrame.TextRange.languageID = language_id
if target_shape.HasTable:
for r in range(1, target_shape.Table.Rows.Count + 1):
for c in range(1, target_shape.Table.Columns.Count + 1):
target_shape.Table.Cell(r, c).Shape.TextFrame.TextRange.LanguageID = language_id
# look the constants msoGroup and msoSmartArt up
if target_shape.Type in [6, 24]:
for i in range(1, target_shape.GroupItems.Count + 1):
change_all_subshapes(target_shape.GroupItems.Item(i), language_id)
# necessary: hopefully ppt is open after a second
time.sleep(1)
print('all slides')
for i in range(1, presentation.Slides.Count + 1):
for j in range(1, presentation.Slides(i).Shapes.Count + 1):
change_all_subshapes(presentation.Slides(i).Shapes(j), target_language)
print('master shapes')
for i in range(1, presentation.SlideMaster.CustomLayouts.Count + 1):
for j in range(1, presentation.SlideMaster.CustomLayouts(i).Shapes.Count + 1):
change_all_subshapes(presentation.SlideMaster.CustomLayouts(i).Shapes(j), target_language)
presentation.SaveAs(outfile_name)
presentation.Close()
ppt.Quit()
在做宏来改变所有形状的语言时，我遇到了同样的问题。 据我所知，在 PPT2007 中，无法以编程方式在图表和 SmartArt 等对象上设置语言。无法在这些对象上的 VBA 中设置 languageID。但是，可以通过单击 SmartArt 对象或图表对象来更改语言。
对于其他对象：
子CreateSocialWorkPresentation() Dim pptApp 作为对象 将 pptPres 调暗为对象 变暗 pptSlide 作为对象
' Create PowerPoint application
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = True
' Create a new presentation
Set pptPres = pptApp.Presentations.Add
' Add title slide
Set pptSlide = pptPres.Slides.Add(1, 1) ' ppLayoutTitle
With pptSlide
.Shapes.Title.TextFrame.TextRange.Text = "The Impact of Social Work on Society and Employment"
.Shapes.Placeholders(2).TextFrame.TextRange.Text = "Empowering Communities, Creating Opportunities"
End With
' Slide 2: Introduction to Social Work
Set pptSlide = pptPres.Slides.Add(2, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Introduction to Social Work"
.Shapes(2).TextFrame.TextRange.Text = "Definition of Social Work" & vbCrLf & _
"Historical Background" & vbCrLf & _
"Key Principles (e.g., social justice, human rights, empowerment)"
End With
' Slide 3: Importance of Social Work in Society
Set pptSlide = pptPres.Slides.Add(3, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Importance of Social Work in Society"
.Shapes(2).TextFrame.TextRange.Text = "Improving Quality of Life" & vbCrLf & _
"Addressing Social Injustice" & vbCrLf & _
"Promoting Equality and Inclusion" & vbCrLf & _
"Supporting Vulnerable Populations"
End With
' Slide 4: Impact on Communities
Set pptSlide = pptPres.Slides.Add(4, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Impact on Communities"
.Shapes(2).TextFrame.TextRange.Text = "Strengthening Families and Relationships" & vbCrLf & _
"Enhancing Mental Health and Well-being" & vbCrLf & _
"Providing Access to Resources and Services" & vbCrLf & _
"Building Resilience and Coping Skills"
End With
' Slide 5: Social Work in Job Creation
Set pptSlide = pptPres.Slides.Add(5, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Social Work in Job Creation"
.Shapes(2).TextFrame.TextRange.Text = "Overview of Job Opportunities in Social Work" & vbCrLf & _
"Roles and Responsibilities (e.g., social workers, counselors, community organizers)" & vbCrLf & _
"Employment Trends and Growth in the Field"
End With
' Slide 6: Economic Contribution
Set pptSlide = pptPres.Slides.Add(6, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Economic Contribution"
.Shapes(2).TextFrame.TextRange.Text = "Contribution to GDP (Gross Domestic Product)" & vbCrLf & _
"Role in Economic Development" & vbCrLf & _
"Social Enterprises and Social Impact Businesses"
End With
' Slide 7: Case Studies and Success Stories
Set pptSlide = pptPres.Slides.Add(7, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Case Studies and Success Stories"
.Shapes(2).TextFrame.TextRange.Text = "Highlight Real-life Examples of Social Work Impact" & vbCrLf & _
"Showcase Successful Programs or Interventions" & vbCrLf & _
"Include Testimonials or Quotes from Beneficiaries"
End With
' Slide 8: Challenges and Opportunities
Set pptSlide = pptPres.Slides.Add(8, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Challenges and Opportunities"
.Shapes(2).TextFrame.TextRange.Text = "Discuss Challenges Faced by Social Workers (e.g., limited resources, stigma)" & vbCrLf & _
"Opportunities for Innovation and Collaboration" & vbCrLf & _
"Importance of Advocacy and Policy Change"
End With
' Slide 9: Future Outlook
Set pptSlide = pptPres.Slides.Add(9, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Future Outlook"
.Shapes(2).TextFrame.TextRange.Text = "Emerging Trends in Social Work" & vbCrLf & _
"Integration of Technology (e.g., AI, digital platforms)" & vbCrLf & _
"Importance of Continuous Learning and Professional Development"
End With
' Slide 10: Conclusion
Set pptSlide = pptPres.Slides.Add(10, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Conclusion"
.Shapes(2).TextFrame.TextRange.Text = "Recap Key Points" & vbCrLf & _
"Emphasize the Value of Social Work to Society and Individuals" & vbCrLf & _
"Call to Action (e.g., support social work initiatives, advocate for funding)"
End With
' Slide 11: Q&A
Set pptSlide = pptPres.Slides.Add(11, 2) ' ppLayoutText
With pptSlide
.Shapes(1).TextFrame.TextRange.Text = "Q&A"
.Shapes(2).TextFrame.TextRange.Text = "Open the floor for questions and discussions"
End With
' Clean up
Set pptSlide = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
结束子