danovkos
01-19-2011, 07:32 AM
Hi all,
pls. i can not figured out, why my window becomes inactive after rugnning my macro. I dont know, which window is active after finishing my macro. It seems, that none of them. :(
Any suggestions?
thx a lot
this is my macro:
Sub GoToPASTEview()
Dim CIF As Variant
Dim cif2 As Long
Dim pval, pvall2 As String
Dim i
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim vysledok As Variant
Dim found As Variant
Dim rng As Range
Dim LookFor As Range
Dim cell As Range
Dim CifDOclipu As Variant
Dim MyText As DataObject, TextStr As String 'kvôli natiahnutiu cifu do clipu
Set MyText = New DataObject
CIF = ActiveCell.Value
On Error GoTo Exits
Application.EnableEvents = False
pvall2 = Workbooks(PrehladyNAMEVp).Worksheets("view").Range("b1").Value 'POZOR TOTO JE NA cif UNDO
Workbooks(PrehladyNAMEVp).Worksheets("view").Range("al3").Value = pvall2 'POZOR TOTO JE NA cif UNDO
Set rng = Workbooks(PrehladyNAMEVp).Sheets("ALL").Range("C56:D10000")
If Len(ActiveCell.Value) < 4 Then GoTo kratkeslovo
vysledok = Left(ActiveCell.Value, Len(ActiveCell.Value) - 3) 'overovanie či nejde o č.úč.
If IsNumeric(vysledok) Then vysledok = CLng(vysledok)
found = Application.VLookup(vysledok, rng, 1, 0)
If IsError(found) = False Then
'If IsNumeric(vysledok) Then
Sheet1.Activate
' Range("A1").Select
Rem vlož hodnotu button
On Error GoTo 0
Range("B1").Select
'vysledok = Range("b1").Value
Range("b1").Value = vysledok
Exit Sub
End If
If Not IsNumeric(ActiveCell.Value) Then
kratkeslovo:
With Workbooks(PrehladyNAMEVp)
shtALL.Activate
With Worksheets("ALL")
With Sheets("ALL").TextBoxALL
Sheets("ALL").TextBoxALL.Activate
Sheets("ALL").TextBoxALL.Value = ""
Sheets("ALL").TextBoxALL.Activate
Range("j1").ClearContents
Sheets("ALL").TextBoxALL.Value = CIF
SendKeys Chr(13), 1
If Not IsNumeric(Sheets("all").Range("B1").Value) Then
Exit Sub
End If
For i = 1 To 1000000
Next i
With Sheets("view")
.Select
With .Range("B1")
.Value = Sheets("all").Range("B1").Value
.Select
End With
End With
End With
End With
End With
Exit Sub
End If
If Len(ActiveCell.Value) > 7 Then
With Workbooks(PrehladyNAMEVp)
shtALL.Activate
With Worksheets("ALL")
With Sheets("ALL").TextBoxALL
Sheets("ALL").TextBoxALL.Activate
Sheets("ALL").TextBoxALL.Value = ""
Sheets("ALL").TextBoxALL.Activate
Range("j1").ClearContents
Sheets("ALL").TextBoxALL.Value = CIF
SendKeys Chr(13), 1
If Not IsNumeric(Sheets("all").Range("B1").Value) Then
Exit Sub
End If
For i = 1 To 1000000
Next i
pvall2 = Range("b1").Value
With Sheets("view")
.Select
With .Range("B1")
.Value = Sheets("all").Range("B1").Value
.Select
End With
End With
End With
End With
End With
Exit Sub
End If
If Len(ActiveCell.Value) < 3 Then
MsgBox "Sranduješ? Ja ti to tam môžem načítať, ale asi z tohto mini čísla nič nezistíš :)"
Exit Sub
End If
Exits:
Application.EnableEvents = True 'púšťaj iné makrá
Sheet1.Activate
Rem vlož hodnotu button
On Error GoTo ExitsGTPV
'POZOR TOTO JE NA cif UNDO - tu bolo pôvodne undo cody 3 riadky
Rem copy z CORE
'On Error GoTo Excel:
Worksheets("view").Range("b1").Value = CIF ' newwwwwwwwwwwwwwwwwwwwwwwwww
ExitsGTPV:
' urob jedinú zmenu v sheete
If Worksheets("view").Range("aj1").Value = "zmena" Then
Worksheets("view").Range("aj1").Value = "zmena2"
Else
Worksheets("view").Range("aj1").Value = "zmena"
End If
Application.ScreenUpdating = True ' neupdatuj screen
CifDOclipu = CIF
MyText.SetText CStr(CifDOclipu)
MyText.PutInClipboard
'Set cif2 = Nothing
'Set cif = Nothing
Set pval = Nothing
'Set pvall2 = Nothing
Set i = Nothing
Set Msg = Nothing
Set Style = Nothing
Set Title = Nothing
Set Help = Nothing
Set Ctxt = Nothing
Set Response = Nothing
Set MyString = Nothing
Set CifDOclipu = Nothing
Set vysledok = Nothing
Set found = Nothing
Set rng = Nothing
Set LookFor = Nothing
Workbooks(PrehladyNAMEVp).Worksheets("view").Activate
End Sub
pls. i can not figured out, why my window becomes inactive after rugnning my macro. I dont know, which window is active after finishing my macro. It seems, that none of them. :(
Any suggestions?
thx a lot
this is my macro:
Sub GoToPASTEview()
Dim CIF As Variant
Dim cif2 As Long
Dim pval, pvall2 As String
Dim i
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Dim vysledok As Variant
Dim found As Variant
Dim rng As Range
Dim LookFor As Range
Dim cell As Range
Dim CifDOclipu As Variant
Dim MyText As DataObject, TextStr As String 'kvôli natiahnutiu cifu do clipu
Set MyText = New DataObject
CIF = ActiveCell.Value
On Error GoTo Exits
Application.EnableEvents = False
pvall2 = Workbooks(PrehladyNAMEVp).Worksheets("view").Range("b1").Value 'POZOR TOTO JE NA cif UNDO
Workbooks(PrehladyNAMEVp).Worksheets("view").Range("al3").Value = pvall2 'POZOR TOTO JE NA cif UNDO
Set rng = Workbooks(PrehladyNAMEVp).Sheets("ALL").Range("C56:D10000")
If Len(ActiveCell.Value) < 4 Then GoTo kratkeslovo
vysledok = Left(ActiveCell.Value, Len(ActiveCell.Value) - 3) 'overovanie či nejde o č.úč.
If IsNumeric(vysledok) Then vysledok = CLng(vysledok)
found = Application.VLookup(vysledok, rng, 1, 0)
If IsError(found) = False Then
'If IsNumeric(vysledok) Then
Sheet1.Activate
' Range("A1").Select
Rem vlož hodnotu button
On Error GoTo 0
Range("B1").Select
'vysledok = Range("b1").Value
Range("b1").Value = vysledok
Exit Sub
End If
If Not IsNumeric(ActiveCell.Value) Then
kratkeslovo:
With Workbooks(PrehladyNAMEVp)
shtALL.Activate
With Worksheets("ALL")
With Sheets("ALL").TextBoxALL
Sheets("ALL").TextBoxALL.Activate
Sheets("ALL").TextBoxALL.Value = ""
Sheets("ALL").TextBoxALL.Activate
Range("j1").ClearContents
Sheets("ALL").TextBoxALL.Value = CIF
SendKeys Chr(13), 1
If Not IsNumeric(Sheets("all").Range("B1").Value) Then
Exit Sub
End If
For i = 1 To 1000000
Next i
With Sheets("view")
.Select
With .Range("B1")
.Value = Sheets("all").Range("B1").Value
.Select
End With
End With
End With
End With
End With
Exit Sub
End If
If Len(ActiveCell.Value) > 7 Then
With Workbooks(PrehladyNAMEVp)
shtALL.Activate
With Worksheets("ALL")
With Sheets("ALL").TextBoxALL
Sheets("ALL").TextBoxALL.Activate
Sheets("ALL").TextBoxALL.Value = ""
Sheets("ALL").TextBoxALL.Activate
Range("j1").ClearContents
Sheets("ALL").TextBoxALL.Value = CIF
SendKeys Chr(13), 1
If Not IsNumeric(Sheets("all").Range("B1").Value) Then
Exit Sub
End If
For i = 1 To 1000000
Next i
pvall2 = Range("b1").Value
With Sheets("view")
.Select
With .Range("B1")
.Value = Sheets("all").Range("B1").Value
.Select
End With
End With
End With
End With
End With
Exit Sub
End If
If Len(ActiveCell.Value) < 3 Then
MsgBox "Sranduješ? Ja ti to tam môžem načítať, ale asi z tohto mini čísla nič nezistíš :)"
Exit Sub
End If
Exits:
Application.EnableEvents = True 'púšťaj iné makrá
Sheet1.Activate
Rem vlož hodnotu button
On Error GoTo ExitsGTPV
'POZOR TOTO JE NA cif UNDO - tu bolo pôvodne undo cody 3 riadky
Rem copy z CORE
'On Error GoTo Excel:
Worksheets("view").Range("b1").Value = CIF ' newwwwwwwwwwwwwwwwwwwwwwwwww
ExitsGTPV:
' urob jedinú zmenu v sheete
If Worksheets("view").Range("aj1").Value = "zmena" Then
Worksheets("view").Range("aj1").Value = "zmena2"
Else
Worksheets("view").Range("aj1").Value = "zmena"
End If
Application.ScreenUpdating = True ' neupdatuj screen
CifDOclipu = CIF
MyText.SetText CStr(CifDOclipu)
MyText.PutInClipboard
'Set cif2 = Nothing
'Set cif = Nothing
Set pval = Nothing
'Set pvall2 = Nothing
Set i = Nothing
Set Msg = Nothing
Set Style = Nothing
Set Title = Nothing
Set Help = Nothing
Set Ctxt = Nothing
Set Response = Nothing
Set MyString = Nothing
Set CifDOclipu = Nothing
Set vysledok = Nothing
Set found = Nothing
Set rng = Nothing
Set LookFor = Nothing
Workbooks(PrehladyNAMEVp).Worksheets("view").Activate
End Sub