PowerPoint 2007 - 在包含文本的表格、图表等上设置语言

问题描述 投票:0回答:4

所以我有了这个宏,它基本上可以扫描 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
vba ms-office powerpoint
4个回答
9
投票

是的,这在 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

1
投票

虽然已经过去了一点时间...来自 https://superuser.com/questions/432366/how-do-i-change-the-language-of-all-powerpoint-slides-at-once 。由于我更喜欢使用 python,因此使用

win32com
包的 python 版本将是:

infile_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()

0
投票

在做宏来改变所有形状的语言时,我遇到了同样的问题。 据我所知,在 PPT2007 中,无法以编程方式在图表和 SmartArt 等对象上设置语言。无法在这些对象上的 VBA 中设置 languageID。但是,可以通过单击 SmartArt 对象或图表对象来更改语言。

对于其他对象:

  • 分组项目 - 我必须以编程方式遍历组中的所有对象(如 Otaku 帖子中的示例)以设置语言
  • 表格 - 我遍历了所有单元格。

0
投票

子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

结束子

© www.soinside.com 2019 - 2024. All rights reserved.