Есть ли способ вызова нестандартных форм в VBA; using application.caller не работает

Question

Я хочу назначить макрос фигурам в моей книге, где макрос назначает относительную гиперссылку на форму, которая его вызвала. Я попытался использовать application.caller, чтобы получить имя формы, чтобы назначить гиперссылку, но она не работает для всех фигур, таких как форматы схемы последовательности операций. Любые предложения о том, как я могу заставить его работать на всех фигурах? Я получаю ошибку времени выполнения, элемент с указанным именем не найден, для всех форм диаграммы потока в моем листе. Этот код работает для стандартных форм, таких как прямоугольники; но в моем документе требуются форма последовательности операций.

'Hyperlink to tab "control point log" using text in shape and cell values 

Sub Controlpointhyperlink() 
Dim rowvar as integer 

ActiveSheet.Shapes(Application.Caller).Select 
Selection.ShapeRange.Item(1).Name = "thisshape" 

rowvar = Application.WorksheetFunction _ 
    .Match(ActiveSheet.Range("C2").Value & _ 
    ActiveSheet.Shapes("thisshape").TextFrame2.TextRange.Text, _ 
    Sheets("Control Point Log").Range("A1:A700"), 0) 

With ActiveSheet 
    .Hyperlinks.Add Anchor:= .Shapes("thisshape"), _ 
    Address:=ActiveWorkbook.Name & "#" & "'Control Point Log'!$C$" & rowvar 
End With 

End Sub 

Answer 1

Проблема в вашем коде, вы меняете имя каждой формы на «thisshape», а затем добавляете к ней гиперссылку. Я попытался изменить свой код, поэтому ссылка на форму устанавливается в начале макроса. Затем макрос использует эту ссылку. И перед вызовом функции MATCH была добавлена ​​проверка ошибки, поэтому, если функция ничего не обнаружит, появится поле mesage. Я тестировал его с различными формами, включая формы блок-схемы. Надеюсь это поможет.

Sub Controlpointhyperlink() 

    Dim callerShapeName As String 
    callerShapeName = Application.Caller 

    With ActiveSheet 
     Dim callerShape As Shape 
     Set callerShape = .Shapes(callerShapeName) 

     Dim findWhat As String 
     findWhat = .Range("C2").Value & callerShape.TextFrame2.TextRange.Text 

     Dim findWhere As Range 
     Set findWhere = Sheets("Control Point Log").Range("A1:A700") 

     Dim rowvar As Double 

     Err.Number = 0 
     On Error Resume Next 

     rowvar = Application.WorksheetFunction.Match(findWhat, findWhere, 0) 
     If (Err.Number = 1004) Then 
      MsgBox "No match found for '" & findWhat & "' in range '" & findWhere.Address & "'." 
      Exit Sub 
     End If 

     On Error GoTo 0 

     Dim addressText As String 
     addressText = ActiveWorkbook.Name & "#" & "'Control Point Log'!$C$" & rowvar 
     .Hyperlinks.Add Anchor:=callerShape, Address:=addressText 
    End With 

End Sub