Excel VBA как скопировать информацию из одной ячейки в другую между рабочими листами с помощью гиперссылки

Question

У меня есть календарь, который я пытаюсь создать, который будет выделять любые дни, на которых есть действия. Существует ежегодный обзор, который показывает все месяцы в данном году. В этом представлении я установил, что если в любой день запланирована активность, будет выделен этот день. То, что я пытаюсь выполнить, - если вы выберете дату из этого представления, она перенесет вас на другой лист, который будет иметь более подробное расписание за рассматриваемую неделю. У меня есть все инструменты, созданные для отображения деталей для этой даты, однако моя проблема заключается в том, чтобы вытащить эту дату из ежегодного листа календаря и ввести его в данную ячейку на недельном листе.

Это код, который я использовал, если для одного связанного с ячейкой гиперссылки, но я не могу заставить его работать в целом с любой гиперсвязной ячейкой.

Dim GSourceCell As String 

Private Sub workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) 

If Sh.Name = "Year" Then 
    If GSourceCell = "C8" Then 
    Sheets("Current Week").Range("G4").Value = Sheets("Year").Range("C8").Value 
    Else 
     Sheets("Current Week").Range("G4").Value = "" 
    End If 
End If 
End Sub 


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 

    If Sh.Name = "Year" Then 
     'Capture last active cell on Hyperlinks worksheet and store in global variable 
     GSourceCell = Target.address(False, False) 
    End If 

End Sub 

Это то, что я думал, будет работать для общего случая.

Dim GSourceCell As String 

Private Sub workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink) 

If Sh.Name = "Year" Then 
    If GSourceCell = Sheets("Year").Cells(ActiveCell.Row, ActiveCell.Column).address Then 
    Sheets("Current Week").Range("G4").Value = Sheets("Year").Range(Cells(ActiveCell.Row, ActiveCell.Column)).Value 
    Else 
     Sheets("Current Week").Range("G4").Value = "" 
    End If 
End If 
End Sub 


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 

    If Sh.Name = "Year" Then 
     'Capture last active cell on Hyperlinks worksheet and store in global variable 
     GSourceCell = Target.address(False, False) 
    End If 

End Sub  

Любая помощь в этом была бы высоко оценена. Спасибо

Answer 1

Несколько мыслей:

Если переместить события из ThiwWorkbook модуля и в модуль листа «Год», у вас есть немного больше контроля над тем, когда пожарами событий. (И вы можете исключить один из своих заявлений If.)

Поскольку вы уже используете событие Worksheet_SelectionChange, почему бы просто не использовать этот юг, чтобы проверить, есть ли у нового выбора гиперссылка? Затем вы можете выполнить все ваши вычисления в том же подпункте. Например:

Option Explicit 

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

'This code is located in the sheet module for your "Year" sheet. 
If Target.Hyperlinks.Count = 1 Then 
    'If the new selection is a hyperlinked cell, put the cell's value in G4 on the _ 
    'Current Week sheet. 
    Sheets("Current Week").Range("G4").Value = Target.Value 
Else 
    'If the cell isn't hyperlinked, put nothing in G4. 
    Sheets("Current Week").Range("G4").Value = vbNullString 
End If 

End Sub