Создание гиперссылки на форму для скольжения

Question

Я пытаюсь создать гиперссылку для только что созданной фигуры oSh на вновь созданный слайд oSlide через VBA.

Форма находится на слайде, отличном от вновь созданного слайда.

Код для создания формы и слайда.

Private Function GetSectionNumber( _
  ByVal sectionName As String, _
  Optional ParentPresentation As Presentation = Nothing) As Long

If ParentPresentation Is Nothing Then
    Set ParentPresentation = ActivePresentation
End If

GetSectionNumber = -1
With ParentPresentation.SectionProperties
    Dim i As Long
    For i = 1 To .Count
        If .Name(i) = sectionName Then
            GetSectionNumber = i
            Exit Function
        End If
    Next i
End With
End Function


Public Function GetLayout( _
  LayoutName As String, _
  Optional ParentPresentation As Presentation = Nothing) As CustomLayout

If ParentPresentation Is Nothing Then
    Set ParentPresentation = ActivePresentation
End If

Dim oLayout As CustomLayout
For Each oLayout In ParentPresentation.SlideMaster.CustomLayouts
    If oLayout.Name = LayoutName Then
        Set GetLayout = oLayout
        Exit For
    End If
Next
End Function


Private Sub CommandButton1_Click()

Dim Sld As Slide
Dim Shp As Shape

'ERROR HANDLING
If ActivePresentation.Slides.Count < 5 Then
    MsgBox "You do not have any slides in your PowerPoint project."
    Exit Sub
End If

Set Sld = Application.ActiveWindow.View.Slide

If Sld.SlideIndex <> 5 Then
    MsgBox "You are not on the correct slide."
    Exit Sub
End If

Set Sld = Application.ActiveWindow.View.Slide

Call AddCustomSlide

Unload UserForm1

End Sub


Sub AddCustomSlide()

'Create new slide
Dim oSlides As Slides, oSlide As Slide
Dim Shp As Shape
Dim Sld As Slide
Dim SecNum As Integer, SlideCount As Integer, FirstSecSlide As Integer

Set oSlides = ActivePresentation.Slides
Set oSlide = oSlides.AddSlide(oSlides.Count - 2, GetLayout("Processwindow"))
SecNum = GetSectionNumber("Main Process")
With ActivePresentation.SectionProperties
    SlideCount = .SlidesCount(SecNum)
    FirstSecSlide = .FirstSlide(SecNum)
End With
oSlide.MoveTo toPos:=FirstSecSlide + SlideCount - 1

If oSlide.Shapes.HasTitle = msoTrue Then
    oSlide.Shapes.Title.TextFrame.TextRange.Text = TextBox1
End If

'Add SmartArt
'Set Shp = oSlide.Shapes.AddSmartArtApplication.SmartArtLayouts(1)

'Create Flowchart Shape
Dim oSh As Shape
Set oSh = ActiveWindow.Selection.SlideRange.Shapes.AddShape(msoShapeFlowchartPredefinedProcess, 50, 100, 83.52, 41.62)

With oSh
    With .TextFrame.TextRange
        .Text = TextBox1

        With .Font
            .Name = "Verdana (Body)"
            .Size = 8
            .Bold = msoFalse
            .Italic = msoFalse
            .Underline = msoFalse
            .Shadow = msoFalse
            .Emboss = msoFalse
            .BaselineOffset = 0
            .AutoRotateNumbers = msoFalse
            '.Color.SchemeColor = RGB(255, 255, 255)
        End With   ' Font

    End With   ' TextRange
End With   ' oSh, the shape itself

End Sub

Answer 1

Я предполагаю, что вы хотите это в последней части, которая выполняет форматирование шрифта:

Dim URLorLinkLocationText as String
With oSh.TextFrame.TextRange.ActionSettings(ppMouseClick)
  .Action = ppActionHyperlink
  .Hyperlink.SubAddress = URLorLinkLocationText
End With