PDA

View Full Version : Solved: Macro "Stautsbar" from ThisWorkbook i want for whole excel



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

GTO
04-16-2010, 05:30 AM
Try:

In a new Class Module named clsExcelAppEvents :


Option Explicit

Public WithEvents App As Excel.Application

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

MsgBox "Selection changed in " & Sh.Parent.Name & String(2, vbCrLf) & _
"Your current code here...", 0, ""
End Sub


In the ThisWorkbook Module :

Option Explicit

Dim ExcelEvent As New clsExcelAppEvents

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ExcelEvent.App = Nothing
End Sub

Private Sub Workbook_Open()
Set ExcelEvent.App = Application
End Sub

Hope that helps,

Mark

danovkos
04-16-2010, 05:57 AM
thx a lot for help
but
i insert callsmodule to my workbook TestA. Default name was Class1. I try it change to your defined name (clsExcelAppEvents ) but it return error : NOT A LEGAL OBJECT NAME. I tried change the name with Properties window in field (Name).

Whats wrong pls?

GTO
04-16-2010, 06:11 AM
It is a legal name. Make sure you did not accidently place any spaces in it as you typed.

danovkos
04-16-2010, 06:17 AM
It is a legal name. Make sure you did not accidently place any spaces in it as you typed.

of course that i had space in the name :(
sorry for my stupidity

now it works like a charm
thank you very much for help

GTO
04-16-2010, 06:37 AM
of course that i had space in the name :(


If it is of any consolation, you will note how quickly that error jumped to my mind (I may have done the same thing a time or two :rofl: )

danovkos
05-03-2010, 10:51 PM
Hi GTO,
i used this solution, but after time i figured out, that it taked very slow filtering of my data. When i filtered my data without implement your codes and module it takes max. 1 sec. but after implementing this code it takes 10 or 12 sec. And now the problem. Because i dont want to ask you again and take you other time, i wanted only delete your codes and module (Class-event) and hoped, that it will return to old quick working but it didnt.
Do you have any idea why my data still filtering very slow? I removed Class-event and delete code what you wrote, but nothings helps.

thx for help
or other guys any suggestions?

GTO
05-04-2010, 05:53 AM
Hi danovkos,

I do not see why it would slow down or speed up, depending on whether the event was fired from application level, or workbook level.

Are you sure you did not change any code from the way listed at #1?

Mark

danovkos
05-04-2010, 07:32 AM
Yes, i changed it:( :doh: , because i needed it adapt to my conditions and my wb.
this is my final:



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
Dim found5 As Variant
Dim found6 As Variant
Dim found7 As Variant
Dim found8 As Variant
Dim found9 As Variant
Dim found10 As Variant
Dim found11 As Variant
'If GetUserName() = "s203855" Then Exit Sub
'Do
'Loop
On Error GoTo koniec
'With Application.WorksheetFunction
'found = " |||| Spávca=" & Application.VLookup(lookFor.Value, rng, 12, 0)
'End With
On Error GoTo koniec

If Target.Cells.Count = 1 Then
If IsNumeric(Target) = True Then
With Application.WorksheetFunction

' Set lookFor = Sheets("Sheet2").Range("A1")
Set lookFor = Target
Set rng = Workbooks("Prehlady2010.xls").Sheets("piv all").Columns("A:T")

'On Error Resume Next
On Error GoTo koniec

' If .Subtotal(103, Target) > 1 Then GoTo bez
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")
found5 = " | KRIZ=" & Application.VLookup(lookFor.Value, rng, 10, 0)
found6 = " | krieš=" & Application.VLookup(lookFor.Value, rng, 8, 0)
found7 = " | DE=" & Application.VLookup(lookFor.Value, rng, 16, 0)
found8 = " | MesPrer=" & Format(Application.VLookup(lookFor.Value, rng, 14, 0), "mmmm yy")
found9 = " | Seg=" & Application.VLookup(lookFor.Value, rng, 6, 0)

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")
statusLine = statusLine & (found5)
statusLine = statusLine & (found6)
statusLine = statusLine & (found7)
statusLine = statusLine & (found8)
statusLine = statusLine & (found9)
' statusLine = statusLine & " SUMA v Sk=" & Format(.Subtotal(109, Target) * 30.126, "##,##0.00 " & "Sk")
' statusLine = statusLine & "; Min=" & .Min(Target)
' statusLine = statusLine & "; Max=" & .Max(Target)

End With
End If
End If
'On Error GoTo 0
On Error GoTo koniec

Application.StatusBar = statusLine
koniec:
If IsError(Target) = False Then
If IsNumeric(Target) = False Then
Application.StatusBar = "Ready"
'---------- nie je numerická hodnota v aktívnej bunke
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
End If

Application.StatusBar = statusLine
End Sub