DeepSeek+PPT+百度云：15分钟帮你搭建超级PPT文档助手！保姆级开源代码~（下）

#DeepSeek #VBA #ChatPPT

安少

KVP

接上篇：《DeepSeek+PPT+百度云：15分钟帮你搭建超级PPT文档助手！保姆级开源代码~（上）》

</ 操作4

运行测试与调试

接下来就是调试过程了。先简单调试下，直接写一个sub进行调试。

' 基础测试流程，测试指数 ☆☆
Sub TestWebRequest()
  Dim codeStr As String    
  Dim ret As Boolean    
  codeStr = GetCodeStringByRequest("选中所有页面，且设置文本颜色为红色")    
  If Len(codeStr) > 0 Then
    ret = RunDynamicCode(codeStr)
  Else
    ret = False
  End If    
End Sub

要不升级点儿难度？？我们加一个交互界面！！！

VBA窗口也可以在插入地方手动拖拉拽搞一个。

然后写点儿测试代码（测试代码为窗口的按钮执行代码）

' 界面测试流程，测试指数 ☆☆☆☆
Private Sub btnAgentTool_Click()
  Dim code As String
  If tbInput.Text <> "" Then
    code = MouleBaidu_V2.GetCodeStringByRequest(tbInput.Text)
    tbInfo.Text = code
    If Len(code) > 0 Then
      RunDynamicCode (code)
      MsgBox "执行操作成功！"
      End If
  End If

' 启动窗口
Dim myForm As DeepSeekTool
Sub OpenWindowTool()
   Set myForm = New DeepSeekTool
   myForm.Show    
End Sub

要不升级点儿难度？？我们加一个交互界面！！！

再稍微优化下，我们把输入框改成直接直接读取幻灯片备注栏内容，这样就是可以实现，在页面下面输入即操作的ChatPPT功能了。

' 幻灯片备注栏操作流程，测试指数 ☆☆☆☆☆
Sub NoteAsAIInput()
  Dim noteStr As String
    noteStr = GetSlideNotesText
    If Len(noteStr) = 0 Then
        Exit Sub
    End If

    Dim codeStr As String
    Dim ret As Boolean
    codeStr = GetCodeStringByRequest(noteStr)    
    If Len(codeStr) > 0 Then
        ret = RunDynamicCode(codeStr)
        SetSlideNotesText (codeStr)
    Else
        ret = False
    End If        
End Sub

Function GetSlideNotesText() As String
    Dim slide As slide
    Dim notesText As String
    Dim shp As shape
    Dim foundNotes As Boolean

    ' 获取当前选中的幻灯片
    Set slide = ActiveWindow.Selection.SlideRange(1)

    ' 初始化标志
    foundNotes = False

    ' 遍历备注页中的所有形状
    For Each shp In slide.NotesPage.Shapes
        ' 检查形状是否有文本框并且包含文本
        If shp.HasTextFrame And shp.TextFrame.HasText Then
            notesText = shp.TextFrame.textRange.Text
            foundNotes = True
            Exit For ' 找到备注文本后退出循环
        End If
    Next shp

    ' 输出备注文本
    If foundNotes Then
        GetSlideNotesText = notesText
    Else
        MsgBox "未找到备注内容。"
        GetSlideNotesText = ""
    End If

End Function

' 设置幻灯片备注 
Function SetSlideNotesText(noteStr As String) As String

    Dim slide As slide
    Dim notesText As String
    Dim shp As shape
    Dim foundNotes As Boolean
    
    ' 获取当前选中的幻灯片
    Set slide = ActiveWindow.Selection.SlideRange(1)

    ' 初始化标志
    foundNotes = False

    ' 遍历备注页中的所有形状
    ' placeholder有不存在情况，所以用笨办法简单测试
    For Each shp In slide.NotesPage.Shapes
        ' 检查形状是否有文本框
        If shp.HasTextFrame Then
            ' 设置备注文本
            shp.TextFrame.textRange.Text = noteStr
            foundNotes = True
            Exit For ' 找到文本框后退出循环
        End If
    Next shp

    ' 如果没有找到文本框，添加一个新的文本框
    If Not foundNotes Then
        Set shp = slide.NotesPage.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 50, 500, 200)
        shp.TextFrame.textRange.Text = noteStr
    End If
End Function