VBA Excel：在另一个工作簿上获取单击的单元格地址

Question

I have an excel file A with a macro and I have to retrive a cell´s adress in another excel file B by the user´s click on it.

The macro looks like this.

In the Class :

Public WithEvents appevent As Application

Private Sub appevent_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
ClickedCell = ActiveCell.Address
End Sub

In the Module

Sub ClickedCellSub()
Dim WbA As Variant, WbB As Variant
WbA = ThisWorkbook.Name
WbB = "B.xlsx"
MsgBox "Please double click on the Assembly SS 00 you want to compare"
Set myobject.appevent = Application
Workbooks(WbB).Sheets(1).Activate
Set myobject.appevent = Nothing
MsgBox ClickedCell
Workbooks(WbA).Activate
End Sub

The problem is, the macro doesn´t wait for the event DoubleClick on the other excel sheet and goes to the end.

How can I stop the macro until the event happens?

Many thanks in advance!

Answer 1

I would use event sinking, but not sure how you have approached it, but this is how i'd use.

In a class use the following :

Private WithEvents wb As Excel.Workbook
Private rng As Excel.Range

Public Event evtCellClicked(rngClicked As Excel.Range)
Public Event evtCellDoubleClicked(rngDoubleCliecked As Excel.Range)

Public Sub init(wbInput As Excel.Workbook)
    Set wb = wbInput
End Sub

Public Property Get CellClicked() As Excel.Range
    CellClicked = rng
End Property

Private Sub wb_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Set rng = Target
    RaiseEvent evtCellClicked(Target)
End Sub

Private Sub wb_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set rng = Target
    RaiseEvent evtCellClicked(Target)
End Sub

Answer 2

I changed the code. In the module:

enter Option Explicit
Private mobjApplication As clsApplication
Global ClickedCell As String

Sub Vergleichen()
Dim StruktBer As Variant        


StruktBer = Application.GetOpenFilename(, , "Strukturbericht öffnen")                       '####Name der Datei aus der Strukturberich

Set mobjApplication = New clsApplication
Workbooks.Open StruktBer

MsgBox "Bitte die Sachnummer der Strukturstufe '00' anklicken die man vergleichen möchte"

End Sub

Sub GOFURTHER

In the Class:

Option Explicit

Private WithEvents mobjApplication As Application

Private Sub Class_Initialize()
Set mobjApplication = Application
End Sub

Private Sub mobjApplication_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    ClickedCell = Target.Address
    Set mobjApplication = Nothing
    Call GOFURTHER

End Sub

The macro stops until the user clicks on the other excel table. Is there any way not to exit the first sub and to remain in the first one?

Answer 3

Why not simply using an InputBox ?
https://docs.microsoft.com/en-us/office/vba/api/excel.application.inputbox
In your prompt you ask the user to select a range in the appropriate document, and that's it.