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