View Single Post
  #13   Report Post  
Posted to microsoft.public.excel.programming
Andrzej Andrzej is offline
external usenet poster
 
Posts: 22
Default On error resume next? question - problem

OK
this code work for every cells for sheets.. but I would like to every cells
(colums) on the right of last this cells
Cecha RSAb Sekcja/Osoba/Data

will be lock.

If you open my project.. so probably you will be know what I want.

Pozdrowienia
Andrzej

Użytkownik "Tom Ogilvy" napisał w wiadomości
...
Just make unlock the default

Dim rng1 as Range
Dim rng2 as Range
Cells.Locked = False
on Error Resume Next
set rng1 = cells.SpecialCells(xlconstants)
set rng2 = cells.specialCells(xlformulas)
On Error goto 0
if not rng1 is nothing then rng1.Locked = True
if not rng2 is nothing then rng2.Locked = True

--
Regards,
Tom Ogilvy

"Andrzej" wrote in message
...
Hi Tom,
I know probably?? why we don't understand each other.
Your code selected some range (similarly how this was in my code) for
example A1:D20 it agrees?
and in this range it work correctly. If cells empty - unlock it,
if cell is full lock it.. OK, but all cells below this range are LOCK,
and I would like to they were UNLOCK., because users will be write new

data
(records),, but how will they write if cells be blocked?

in this example I would like to:

1) column Tand every follows will be lock (U,V,W etc)

2) in range A1:D20 (if cell full - lock, if cell empty - unlock)

3) every cells belows row 20 (but only to column number 20) will be

unlock
(A21:T65535)

I hope so you understand me.



Pozdrawiam Andrzej








Użytkownik "Tom Ogilvy" napisał w wiadomości
...
That is what the code does (based on the assumptions I stated). Sorry

if
you can't get it to work for you.

--
Regards,
Tom Ogilvy


"Andrzej" wrote in message
...
your code didn' t work corectly..

I need:

If cells are empty then is unlock
and if cells.value <"" then i wont to lock this cells in every

sheets..



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