Sledování přístupů do buňky Vyřešeno

[cmuch]

Ahoj,
potřeboval bych poradit jak sledovat přístupy do jedné buňky.

Mám dva sešity a v jednom bych chtěl aby se mi třeba v A6 zobrazoval počet přístupů do A1 v druhém sešitě.
Pokud to půjde bez maker v druhém sešitě budu rád.

Mě se to daří jen zacyklit

Děkuji za rady. Jakékoli.

[Reklama]

[cmuch]

Tak jsem zatím nějak vyřešil přístup do buňky ale ne sledování počtu.

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Oblast As Range
 
'definice sledované oblasti
Set Oblast = Range("A6:A6")
   'test výběru
   If Union(Oblast, Target).Address = Oblast.Address Then
 
'tichý režim
Application.ScreenUpdating = False
 
'otevři soubor
Workbooks.Open Filename:=".......xls"
'ActiveWorkbook.Application.WindowState = xlMinimized
 
'zavři soubor. ukládej v něm změny
Workbooks("Pokus.xls").Close savechanges:=True
 
'tichý režim vypnout
Application.ScreenUpdating = True
 
   End If
End Sub

Bohužel nevím jak to udělat v tom druhém sešitě.
Když tam udělám automaticky zpouštěné makro, tak mi to chodí jen když ten soubor otevřu já, alekdyž se otevře pomocí toho makra v prvním sešitě tak se nic nestane. Asi se nepovolí makra?

Nebo jak to třeba udělat v tom jednom sešitě.

Tady je to druhé makro:

Kód: Vybrat vše

Sub auto_open()
'
    Range("A7").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-6]C+1)"
    Selection.Copy
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A7").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
 
End Sub

Děkuji za radu.

[cmuch]

Tak jsem to vyřešil takto.
V sešitě kde sleduji přístup do buňky jsem udělal toto:
Do kódu listu jsem zadal toto:

Kód: Vybrat vše

Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim Oblast As Range
 
'definice sledované oblasti
Set Oblast = Range("A9:A9")
   'test výběru
   If Union(Oblast, Target).Address = Oblast.Address Then
 
'tichý režim
Application.ScreenUpdating = False
 
Call Pristupy
 
'ESC
Application.CutCopyMode = False
'tichý režim vypnout
Application.ScreenUpdating = True
 
   End If
End Sub

a pak mám ještě v tom sešitě toto makro:

Kód: Vybrat vše

Sub Pristupy()
 
On Error GoTo konec
'otevři soubor
cesta = " \\...............\Pokus.xls"
Workbooks.Open Filename:=cesta
'ActiveWorkbook.Application.WindowState = xlMinimized
 
With Range("A7")
    .FormulaR1C1 = "=SUM(R[-4]C+1)"
    .Copy
    With Range("A3")
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
             :=False, Transpose:=False
    End With
    .ClearContents
End With
 
'zavři soubor. ukládej v něm změny
Workbooks("Pokus.xls").Close savechanges:=True
 
konec:
 
End Sub

Takže všem za shlédnutí děkuji
Vyřešeno zamykám.