ActiveWorkbook.FullName

will tell you the fully qualified path of the workbook. Perhaps that will
help you decide

sFullName = Bk.FullName
sLtr = ""
if inStr(1,sFullName,"Narzedzia",vbTextCompare) then
sLtr = "N"
else if instr(1,sFullName,"Sprawdziany",vbTextCompare) then
sLtr = "S"
else if instr(1,sFullName,"PRZYRZADY",vbTextCompare) then
sLtr = "P"
End if

obviously using sLtr is just to illustrate doing something in the If
statement.

--
Regards,
Tom Ogilvy


"Andrzej" wrote in message
...
Work ok...,but is it different problem.

I have 3 catalogues:
NARZEDZIA,
PRZYRZADY,
SPRAWDZIANY,

and in every of them is two files about the same names, Exactly:
katalog.xls and baza_cech.xls

What happend if some person opened katalog.xls from NARZEDZIA and at the
same time other person opened katalog.xls from ..for example
SPRAWDZIANY...

mistake step out??? and if not... of which file will be search??

Will the change of name of files be only solution?

for example:

katalog_s.xls in SPRAWDZIANY

katalog_p.xls in PRZYRZADY

katalog_n.xls in NARZEDZIA

What do you think?

Pozdrowienia,

Andrzej







U¿ytkownik "Tom Ogilvy" napisa³ w wiadomo¶ci
...
If by

If cell = "" Then cell.Locked = False

you want to unlock empty cells then


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i as long, j as Long, max as Long
Dim LiczCols As Long

Dim bk As Workbook
Dim sh As Worksheet
Dim sh1 As Integer
Dim rng as Range

If Not Me.Saved Then
Msg = "Czy zapisac zmiany w (save the change in)"
Msg = Msg & Me.Name & "?"
ans = MsgBox(Msg, vbQuestion + vbYesNoCancel)
Select Case ans
Case vbYes
Me.Save
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
Call DeleteMenu

' blokada komorek wpisanych t(he blockade of full cells )

sh1 = ActiveWorkbook.Worksheets.Count

Application.ScreenUpdating = False

For j = 1 To sh1

Sheets(j).Activate
Sheets(j).Unprotect
cells.Locked = True
set rng = nothing
On error resume Next
set rng = cells.SpecialCells(xlBlanks)
On Error goto 0
if not rng is nothing then
rng.Locked = False
end if
Sheets(j).Protect

Next j

Application.ScreenUpdating = True
End Sub

--
Regards,
Tom Ogilvy

"Andrzej" wrote in message
...
ok, but something is wrong.. because when find "cecha" displays
error: Aplication defined or object defined error.. (1004)

Mayby I made any mistakein filekatalog.xls?

Can you look at this code? (in file katalog)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i, j, max, LiczCols As Integer

Dim bk As Workbook
Dim sh As Worksheet
Dim sh1 As Integer


If Not Me.Saved Then
Msg = "Czy zapisac zmiany w (save the change in)"
Msg = Msg & Me.Name & "?"
ans = MsgBox(Msg, vbQuestion + vbYesNoCancel)
Select Case ans
Case vbYes
Me.Save
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
Call DeleteMenu

' blokada komorek wpisanych t(he blockade of full cells )

sh1 = ActiveWorkbook.Worksheets.Count

Application.ScreenUpdating = False

For j = 1 To sh1

Sheets(j).Activate
Sheets(j).Unprotect
'max = Range(Cells(1, 1), Selection.End _
(xlToRight)).Count
max = 1
'liczba kolumn wype³nionych
Cells(1, 1).Select
' okreslenie zakresu
LiczCols = Range(Selection, Selection.End _
(xlToRight)).Count
For i = 1 To LiczCols
If Range(Selection, Selection.End _
(xlDown)).Count max _
Then max = Range _
(Selection, Selection.End(xlDown)).Count
Cells(1, i).Select ' -in this line is ERROR
Next i
' Cells(10, 1) = "A1:A" & max
' zaznacz zakres i zablokuj niepuste komorki
Range("A1:A" & max).Select
Range(Selection, Selection.End _
(xlToRight)).Select
'Selection.Locked = True
For Each cell In Selection
If cell < "" Then cell.Locked = True
If cell = "" Then cell.Locked = False

Next cell

Sheets(j).Protect

Next j

Application.ScreenUpdating = True
End Sub





U¿ytkownik "Tom Ogilvy" napisa³ w wiadomo¶ci
...
On Error Resume Next
set bk = Workbooks("katalog.xls")
On Error goto 0
if bk is nothing then
Set bk = Workbooks.Open _

("D:\!Proj_temp_WSK\OPRZYRZADOWANIEv_6\NARZEDZIA\B AZA\katalog.xls")
End if

--
Regards,
Tom Ogilvy




"Andrzej" wrote in message
...
I have a code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim szukana As Range
Dim Cecha As String
Dim bk As Workbook
Dim sh As Worksheet
Dim sh1 As Worksheet

Application.ScreenUpdating = False

If Not Application.Intersect(Columns("A:A"), Target) _
Is Nothing Then

Cecha = Target.Value
If Cecha = "" Then Exit Sub

On Error Resume Next
Set bk = Workbooks _

("D:\!Proj_temp_WSK\OPRZYRZADOWANIEv_6\NARZEDZIA\B AZA\katalog.xls")
On Error GoTo 0
If bk Is Nothing Then
If Err < 0 Then
Set bk = Workbooks.Open _





(Filename:="D:\!Proj_temp_WSK\OPRZYRZADOWANIEv_6\N ARZEDZIA\BAZA\katalog.xls"
)

End If

Set sh1 = bk.Worksheets(bk.Worksheets.Count)
For Each sh In bk.Worksheets
Set szukana = sh.Cells.Find(What:=Cecha, _
After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, MatchCase:=False)
', _
' SearchFormat:=False)

If szukana Is Nothing Then
If sh.Name = sh1.Name Then
MsgBox "Szukana cecha """ & Cecha & """ nie zosta³a
odnaleziona"
ActiveWorkbook.Close
Target.Value = ""
End If
Else

bk.Activate
sh.Activate
szukana.Activate
MsgBox "Szukana cecha """ & Cecha & """ zosta³a
odnaleziona"
'ActiveWorkbook.Close
'ActiveCell.Value = Cecha
End If
Next sh

End If

Application.ScreenUpdating = True

end sub

I try to ptecect my code before situation that file:

("D:\!Proj_temp_WSK\OPRZYRZADOWANIEv_6\NARZEDZIA\B AZA\katalog.xls")
was earlier opened by differend user.
If this file was earlier opened, then I would like to my code
don't
open
again this file, just only search for "cecha"
else
i would like to my code open the file and search for "cecha"

Someone knows more practical solution ?
this my does not work

Andrzej