danovkos
04-16-2010, 05:04 AM
Hi all,
pls. i have one macro in Workbook "TestA" in ThisWorkbook part "SheetSelectionChange", which works for one opened workbook. But i want to make from this a universal macro , that will works for all opened workbooks of any users. Of course it will works only if user will have opened this "TestA" workbook.
Is it possible and is it hard to do this?
my code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal target As Range)
Dim statusLine As String
Dim lookFor As Range
Dim rng As Range
Dim col As Integer
Dim found As Variant
Dim found2 As Variant
Dim found3 As Variant
Dim found4 As Variant
'Do
'Loop
If IsNumeric(target) = False Then
Application.StatusBar = "Ready"
On Error Resume Next
With Application.WorksheetFunction
statusLine = "Suma=" & Format(.Subtotal(109, target), "##,##0.00")
statusLine = statusLine & " Priemer=" & Format(Round(.Subtotal(101, target), 1), "##,##0.00")
statusLine = statusLine & " Počet=" & .Subtotal(103, target)
End With
End If
On Error GoTo koniec
If IsNumeric(target) = True Then
With Application.WorksheetFunction
' Set lookFor = Sheets("Sheet2").Range("A1")
Set lookFor = target
Set rng = Sheets("piv all").Columns("A:T")
'On Error Resume Next
On Error GoTo koniec
If target.Cells.Count > 1 Or IsEmpty(target) Then Exit Sub
found = " |||| Spávca=" & Application.VLookup(lookFor.Value, rng, 12, 0)
found2 = " Právnik=" & Application.VLookup(lookFor.Value, rng, 13, 0)
found3 = " Angaž.=" & Format(Application.VLookup(lookFor.Value, rng, 3, 0), "##,##0.00")
found4 = " Aktuálny CASH=" & Format(Application.VLookup(lookFor.Value, rng, 20, 0), "##,##0.00")
On Error GoTo koniec
bez:
statusLine = "Suma=" & Format(.Subtotal(109, target), "##,##0.00")
statusLine = statusLine & " Priemer=" & Format(Round(.Subtotal(101, target), 1), "##,##0.00")
statusLine = statusLine & " Počet=" & .Subtotal(103, target)
statusLine = statusLine & (found)
statusLine = statusLine & (found2)
statusLine = statusLine & Format(found3, "##,##0.00")
statusLine = statusLine & Format(found4, "##,##0.00")
End With
End If
'On Error GoTo 0
On Error GoTo koniec
Application.StatusBar = statusLine
koniec:
End Sub
'Private Sub Workbook_Deactivate()
' Application.StatusBar = False
'End Sub
thx for help
pls. i have one macro in Workbook "TestA" in ThisWorkbook part "SheetSelectionChange", which works for one opened workbook. But i want to make from this a universal macro , that will works for all opened workbooks of any users. Of course it will works only if user will have opened this "TestA" workbook.
Is it possible and is it hard to do this?
my code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal target As Range)
Dim statusLine As String
Dim lookFor As Range
Dim rng As Range
Dim col As Integer
Dim found As Variant
Dim found2 As Variant
Dim found3 As Variant
Dim found4 As Variant
'Do
'Loop
If IsNumeric(target) = False Then
Application.StatusBar = "Ready"
On Error Resume Next
With Application.WorksheetFunction
statusLine = "Suma=" & Format(.Subtotal(109, target), "##,##0.00")
statusLine = statusLine & " Priemer=" & Format(Round(.Subtotal(101, target), 1), "##,##0.00")
statusLine = statusLine & " Počet=" & .Subtotal(103, target)
End With
End If
On Error GoTo koniec
If IsNumeric(target) = True Then
With Application.WorksheetFunction
' Set lookFor = Sheets("Sheet2").Range("A1")
Set lookFor = target
Set rng = Sheets("piv all").Columns("A:T")
'On Error Resume Next
On Error GoTo koniec
If target.Cells.Count > 1 Or IsEmpty(target) Then Exit Sub
found = " |||| Spávca=" & Application.VLookup(lookFor.Value, rng, 12, 0)
found2 = " Právnik=" & Application.VLookup(lookFor.Value, rng, 13, 0)
found3 = " Angaž.=" & Format(Application.VLookup(lookFor.Value, rng, 3, 0), "##,##0.00")
found4 = " Aktuálny CASH=" & Format(Application.VLookup(lookFor.Value, rng, 20, 0), "##,##0.00")
On Error GoTo koniec
bez:
statusLine = "Suma=" & Format(.Subtotal(109, target), "##,##0.00")
statusLine = statusLine & " Priemer=" & Format(Round(.Subtotal(101, target), 1), "##,##0.00")
statusLine = statusLine & " Počet=" & .Subtotal(103, target)
statusLine = statusLine & (found)
statusLine = statusLine & (found2)
statusLine = statusLine & Format(found3, "##,##0.00")
statusLine = statusLine & Format(found4, "##,##0.00")
End With
End If
'On Error GoTo 0
On Error GoTo koniec
Application.StatusBar = statusLine
koniec:
End Sub
'Private Sub Workbook_Deactivate()
' Application.StatusBar = False
'End Sub
thx for help