IT練習ノート

IT関連で調べたこと(実際は嵌ったこと)を書いています。

PowerPointで選択したテキストの情報をスライドタイトルも含めてクリップボードに入れるマクロ

f:id:naotoogawa:20191027123302p:plain

Public Sub getSelectedTextInfo()
  Dim s As PowerPoint.Slide
  Set s = GetActiveSlide()
  If s Is Nothing Then
    Debug.Print "アクティブなスライドを取得できません。", vbCritical + vbSystemModal
  Else
    putCB ("スライドタイトル / 内容 = " & s.Shapes.Title.TextFrame.TextRange.Text & " / " & getSelectedText())
  End If
End Sub
  
' 参考 https://tonari-it.com/powerpoint-vba-selection-textrange-font/
Public Function getSelectedText()
  With ActiveWindow.Selection
    If .Type >= ppSelectionText Then
        getSelectedText = .TextRange.Text
    End If
  End With
End Function

' 参考 https://www.ka-net.org/blog/?p=2294
Public Function GetActiveSlide() As Slide
  Dim ret As Slide
  Set ret = Nothing
  On Error Resume Next
  Set ret = ActivePresentation.Slides.FindBySlideID(ActivePresentation.Windows(1).Selection.SlideRange.SlideID)
  On Error GoTo 0
  Set GetActiveSlide = ret
End Function

' クリップボードに入れる
Private Sub putCB(ByVal val As String)
  With CreateObject("Forms.TextBox.1")
    .MultiLine = True
    .Text = val
    .SelStart = 0
    .SelLength = .TextLength
    .Copy
  End With
End Sub