Verificare daca sunt deschise alte workbookuri excel
-
- Mesaje: 105
- Membru din: Mie Feb 19, 2014 10:41 pm
Verificare daca sunt deschise alte workbookuri excel
Salut.
Am un workbook pe server care este utilizat de mai multi colegi si acesti colegi se plang de anumite probleme pe care le au daca mai au deschise si alte workbookuri excel in acelasi timp.
Workbookul meu porneste cu un userform ascunzand Excel ceea ce face ca celelalte workbookuri sa nu fie vizibile. Apoi butoanele de pe userform deschid doar cate un sheet in full screen (deoarece este vorba de tabele si vizualizarea ribbonurilor nu este necesara). De aici iarasi problemele, toate celelalte worksheeturi deschise se deschid full screen.
Am cautat pe forum si pe net si nu am gasit un cod care sa verifice daca sunt deschise alte worksheeturi, sa apara un msgbox de genul "Trebuie sa inchideti toate celelalte worksheeturi Excel" si sa nu deschida worksheetul respectiv.
Codul nu trebuie sa fie legat de denumirea workbookurilor deschise deoarece sunt multi utilizatori si denumirile fisierelor excel deschise nu pot fi prevazute.
Nu pot atasa worksheetul deoarece este masiv, are multe sheeturi, multe informatii si este personalizat. Sper ca m-am facut inteles.
Multumesc.
Am un workbook pe server care este utilizat de mai multi colegi si acesti colegi se plang de anumite probleme pe care le au daca mai au deschise si alte workbookuri excel in acelasi timp.
Workbookul meu porneste cu un userform ascunzand Excel ceea ce face ca celelalte workbookuri sa nu fie vizibile. Apoi butoanele de pe userform deschid doar cate un sheet in full screen (deoarece este vorba de tabele si vizualizarea ribbonurilor nu este necesara). De aici iarasi problemele, toate celelalte worksheeturi deschise se deschid full screen.
Am cautat pe forum si pe net si nu am gasit un cod care sa verifice daca sunt deschise alte worksheeturi, sa apara un msgbox de genul "Trebuie sa inchideti toate celelalte worksheeturi Excel" si sa nu deschida worksheetul respectiv.
Codul nu trebuie sa fie legat de denumirea workbookurilor deschise deoarece sunt multi utilizatori si denumirile fisierelor excel deschise nu pot fi prevazute.
Nu pot atasa worksheetul deoarece este masiv, are multe sheeturi, multe informatii si este personalizat. Sper ca m-am facut inteles.
Multumesc.
Re: Verificare daca sunt deschise alte workbookuri excel
Buna ziua
Mesajul dvs. are niste neclaritati in folosirea unor termeni. Asadar:
Workbook = fisier excel (sau Registru de calcul); Worksheet = foaie dintr-un fisier excel.
Daca am inteles bine din titlul topicului, atunci, ar trebui sa existe un cod care sa ruleze automat la deschiderea fisierului dvs., inainte de orice.
IP
Mesajul dvs. are niste neclaritati in folosirea unor termeni. Asadar:
Workbook = fisier excel (sau Registru de calcul); Worksheet = foaie dintr-un fisier excel.
Daca am inteles bine din titlul topicului, atunci, ar trebui sa existe un cod care sa ruleze automat la deschiderea fisierului dvs., inainte de orice.
Cod: Selectaţi tot
If Workbooks.Count > 1 Then
MsgBox "Nu puteti folosi acest fisier daca aveti si alte fisiere Excel deschise." & Chr(10) & _
"(Salvati si) Inchideti toate fisierele Excel si incercati din nou"
ThisWorkbook.Close
End If
-
- Mesaje: 105
- Membru din: Mie Feb 19, 2014 10:41 pm
Re: Verificare daca sunt deschise alte workbookuri excel
Multumesc mult.
Scuze pentru exprimarea neclara.
Merge brici.
Ati reformulat si mesajul... este perfect.
Scuze pentru exprimarea neclara.
Merge brici.
Ati reformulat si mesajul... este perfect.
Re: Verificare daca sunt deschise alte workbookuri excel
In cazul tau cred ca mai bine corectezi codul din fisierul de pe server, de asa maniera incat sa nu se "atinga" de fisierele excel, deschise pe calculatoarelor userilor...
I don't care what you think of me! Unless you think I'm awesome – in which case, you're right! Carry on
-
- Mesaje: 105
- Membru din: Mie Feb 19, 2014 10:41 pm
Re: Verificare daca sunt deschise alte workbookuri excel
"Sa nu se atinga" in sensul de a nu le influenta functionarea? Sau de a nu le "imprumuta" setarile? Am o problema de exemplu cu rularea acelui fisier de pe server in fuu screen. Toate celelate deschise in paralel se deschid in full screen.
Ce trebuie sa fac pentru asta? M-ati pierdut pe traseu.
Ce trebuie sa fac pentru asta? M-ati pierdut pe traseu.
Re: Verificare daca sunt deschise alte workbookuri excel
Posteaza codul VBA din UserForm (si modul daca exista) si poate putem sa-l modificam.
I don't care what you think of me! Unless you think I'm awesome – in which case, you're right! Carry on
-
- Mesaje: 105
- Membru din: Mie Feb 19, 2014 10:41 pm
Re: Verificare daca sunt deschise alte workbookuri excel
Ok. Multumesc pentru ajutor.
Dar va rog sa nu ma criticati foarte tare. Poate codurile mele nu au simplitatea, limpezimea si coerenta unora scrise de specialisti dar sunt functionale desi sunt "de adunatura".
In ThisWorkbook:
In userform:
In module:
Dar va rog sa nu ma criticati foarte tare. Poate codurile mele nu au simplitatea, limpezimea si coerenta unora scrise de specialisti dar sunt functionale desi sunt "de adunatura".
In ThisWorkbook:
Cod: Selectaţi tot
Private Sub Workbook_Open()
'frmEvaluare.Show vbModeless
If Workbooks.Count > 1 Then
MsgBox "Nu puteti folosi acest fisier daca aveti si alte fisiere Excel deschise." & Chr(10) & _
"(Salvati si) Inchideti toate fisierele Excel si incercati din nou"
ThisWorkbook.Close
End If
Application.ScreenUpdating = False
Application.Visible = True
Application.DisplayFullScreen = True
Application.DisplayFormulaBar = False
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Sheets("Splash").Visible = True
Range("A1:Z1").Select
ActiveWindow.Zoom = True
Range("B2").Select
For Each ws In Worksheets
If ws.Name <> "Splash" Then ws.Visible = False
Next ws
'Range("B2").Select
Application.ScreenUpdating = True
End Sub
'Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
'Application.Visible = True
'End Sub
'Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Cancel = Not BooleanForClosing
'If Cancel = True Then
'MsgBox "Utilizati butonul FINALIZARE", vbOKOnly, "Actiune nepermisa"
'End If
'End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Not PrintOK Then Cancel = True
End Sub
Cod: Selectaţi tot
Option Explicit
Private Sub UserForm_Initialize()
If Sheet13.Range("F2").Value <> vbNullString Then
MsgBox " Aceasta evaluare a fost validata in data de" & " " & Sheet13.Range("F2").Value & "." & vbNewLine & " - Puteti vizualiza continutul." & vbNewLine & " - Editarea nu este posibila."
frmEvaluare.Label3.Caption = "Evaluarea a fost validata in data de" & " " & Sheet13.Range("F2").Value & vbNewLine & " - Vizualizarea este posibila." & vbNewLine & " - Editarea nu este posibila."
Else
frmEvaluare.Label3.Caption = " Evaluarea nu este validata." & vbNewLine & " - Vizualizarea este posibila." & vbNewLine & " - Editarea este posibila."
End If
If Sheet13.Range("F2").Value = vbNullString Then
Me.CommandButton20.Enabled = True
Me.CommandButton17.Enabled = False
Else
Me.CommandButton20.Enabled = False
Me.CommandButton17.Enabled = True
End If
End Sub
Public Function HasContent(text_box As Object) As Boolean
HasContent = (Len(Trim(TextBox1.Value)) > 0)
End Function
Private Sub CommandButton1_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P1
frmEvaluare.Hide
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P2
frmEvaluare.Hide
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton3_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P3
frmEvaluare.Hide
End Sub
Private Sub CommandButton4_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P3_3
frmEvaluare.Hide
End Sub
Private Sub CommandButton5_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P4
frmEvaluare.Hide
End Sub
Private Sub CommandButton6_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P5
frmEvaluare.Hide
End Sub
Private Sub CommandButton7_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P6
frmEvaluare.Hide
End Sub
Private Sub CommandButton8_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P6_3
frmEvaluare.Hide
End Sub
Private Sub CommandButton9_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P8
frmEvaluare.Hide
End Sub
Private Sub CommandButton10_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P9
frmEvaluare.Hide
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton11_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.ScreenUpdating = False
Call HideStuff
Call Select_P10
frmEvaluare.Hide
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton12_Click()
' salveaza si inchide workbookul
Application.DisplayAlerts = False
BooleanForClosing = True
' If ActiveWorkbook.ReadOnly Then
' MsgBox "ATENTIE!" & vbNewLine & "Ati ales sa deschideti aplicatia in modul Read Only." & vbNewLine & _
' "Modificarile pe care le-ati facut nu vor fi salvate." & vbNewLine & _
' "RISCATI PIERDEREA INFORMATIILOR" & vbNewLine & "" & vbNewLine & _
' " - Apasati Cancel pentru a ramane in aplicatie." & vbNewLine & _
' " - Utilizand optiunea File/Save As puteti salva aplicatia in computerul dvs fara a pierde datele introduse." & vbNewLine & _
' " - Apasati OK daca doriti sa inchideti.", vbOKCancel, "AVERTISMENT!"
' Else
Call ShowStuff
ThisWorkbook.Save
'Application.Visible = True
ThisWorkbook.Close
'Application.Quit
'ActiveWorkbook.Close True
' End If
Application.DisplayAlerts = True
End Sub
Private Sub CommandButton13_Click()
' Acces administrator
Dim ws As Worksheet
Dim strPasswd
strPasswd = InputBox("Introduceti parola.", "Autorizare acces")
'Check to see if there is any entry made to input box, or if
'cancel button is pressed. If no entry made then exit sub.
If strPasswd = "" Or strPasswd = Empty Then
MsgBox "Nu ati introdus parola.", vbInformation, "Informatie necesara"
Exit Sub
End If
'If correct password is entered open Employees form
'If incorrect password entered give message and exit sub
If strPasswd = "13021429" Then
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
Application.DisplayFullScreen = False
Application.DisplayFormulaBar = True
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Sheets("Administrare").Select
Range("A1:V1").Select
ActiveWindow.Zoom = True
Range("A2").Select
frmEvaluare.Hide
Else
MsgBox "Parola introdusa nu este corecta.", _
vbOKOnly, "Nu se autorizeaza accesul."
Exit Sub
End If
Application.Visible = True
ActiveWindow.DisplayGridlines = False
End Sub
Private Sub CommandButton15_Click()
Application.Visible = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Call HideStuff
Call Select_EPI
frmEvaluare.Hide
End Sub
Private Sub CommandButton20_Click()
' Valideaza fisierul
Dim ws As Worksheet
Dim strPasswd
strPasswd = InputBox("Introduceti parola.", "Autorizare")
'Check to see if there is any entry made to input box, or if
'cancel button is pressed. If no entry made then exit sub.
If strPasswd = "" Or strPasswd = Empty Then
MsgBox "Nu ati introdus parola.", vbInformation, "Informatie necesara"
Exit Sub
End If
'If correct password is entered open Employees form
'If incorrect password entered give message and exit sub
Sheet13.Range("F2") = Format(Date, "dd.mm.yyyy")
Me.CommandButton20.Enabled = False
Me.CommandButton17.Enabled = True
Call ProtectAllCells
If strPasswd = "1234" Then
MsgBox "Validarea datelor a fost efectuata cu succes.", _
vbOKOnly, "Validare reusita"
frmEvaluare.Label3.Caption = "Evaluarea a fost validata in data de" & " " & Sheet13.Range("F2").Value & vbNewLine & " - Vizualizarea este posibila." & vbNewLine & " - Editarea nu este posibila."
Else
MsgBox "Parola introdusa nu este corecta.", _
vbOKOnly, "Validarea datelor nu a fost efectuata."
Me.CommandButton20.Enabled = True
Me.CommandButton17.Enabled = False
Exit Sub
End If
End Sub
Private Sub CommandButton17_Click()
' Activeaza revizuirea
Dim ws As Worksheet
Dim strPasswd
strPasswd = InputBox("Introduceti parola.", "Autorizare")
If strPasswd = "" Or strPasswd = Empty Then
MsgBox "Nu ati introdus parola.", vbInformation, "Informatie necesara"
Exit Sub
End If
Call UnprotectAllCells
Sheet13.Range("F2").ClearContents
Me.CommandButton20.Enabled = True
Me.CommandButton17.Enabled = False
If strPasswd = "1234" Then
MsgBox "Aceasta evaluare poate fi revizuita." & vbNewLine & "Dupa revizuire trebuie sa validati din nou.."
frmEvaluare.Label3.Caption = "Evaluarea nu este validata." & vbNewLine & " - Vizualizarea este posibila." & vbNewLine & " - Editarea este posibila."
Else
MsgBox "Parola introdusa nu este corecta.", _
vbOKOnly, "Revizuirea datelor nu este posibila."
Me.CommandButton20.Enabled = False
Me.CommandButton17.Enabled = True
Exit Sub
End If
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then
Cancel = True
MsgBox "Butonul ‘X’ nu inchide aplicatia. Utilizati butonul 'Inchidere'.", vbOKOnly, "Actiune nepermisa"
End If
End Sub
Cod: Selectaţi tot
Public BooleanForClosing As Boolean
Sub Open_App()
frmEvaluare.Show vbModeless
Application.Visible = False
End Sub
Sub Select_EPI()
'
' Select_EPI Macro
'
Application.ScreenUpdating = False
Sheets("EPI").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "EPI" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P1()
'
' Select_P1 Macro
'
Application.ScreenUpdating = False
Sheets("P1-Delegari-Bugete").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P1-Delegari-Bugete" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P2()
'
' Select_P2 Macro
'
Application.ScreenUpdating = False
Sheets("P2-Afaceri").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P2-Afaceri" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P3()
'
' Select_P3 Macro
'
Application.ScreenUpdating = False
Sheets("P3-Resurse umane").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P3-Resurse umane" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P3_3()
'
' Select_P3.3 Macro
'
Application.ScreenUpdating = False
Sheets("P3.3- Sanatate si securitate").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P3.3- Sanatate si securitate" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P4()
'
' Select_P4 Macro
'
Application.ScreenUpdating = False
Sheets("P4-Achizitii").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P4-Achizitii" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P5()
'
' Select_P5 Macro
'
Application.ScreenUpdating = False
Sheets("P5-Finante-Conta").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P5-Finante-Conta" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P6()
'
' Select_P6 Macro
'
Application.ScreenUpdating = False
Sheets("P6.1-6.2 Juridic").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P6.1-6.2 Juridic" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P6_3()
'
' Select_P6_3 Macro
'
Application.ScreenUpdating = False
Sheets("P6.3-Asigurari").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P6.3-Asigurari" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P8()
'
' Select_P8 Macro
'
Application.ScreenUpdating = False
Sheets("P8-Sisteme informatice").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P8-Sisteme informatice" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P9()
'
' Select_P9 Macro
'
Application.ScreenUpdating = False
Sheets("P9-Comunicare").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P9-Comunicare" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Select_P10()
'
' Select_P10 Macro
'
Application.ScreenUpdating = False
Sheets("P10-Mediu si resp.sociala").Visible = True
ActiveWindow.ScrollRow = 1
For Each ws In Worksheets
If ws.Name <> "P10-Mediu si resp.sociala" Then ws.Visible = False
Next ws
Range("A1:L1").Select
ActiveWindow.Zoom = True
Range("A1").Select
ActiveSheet.Unprotect "13021429"
'ActiveWindow.DisplayWorkbookTabs = True
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
Application.ScreenUpdating = True
End Sub
Sub Inchidere()
ActiveWindow.ScrollRow = 1
Range("A1:Z1").Select
ActiveWindow.Zoom = True
Application.ScreenUpdating = False
ActiveSheet.Unprotect "13021429"
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
ThisWorkbook.Save
ActiveSheet.EnableSelection = xlUnlockedCells
Application.DisplayFullScreen = False
Application.DisplayFormulaBar = True
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
Application.Visible = False
Application.ScreenUpdating = True
frmEvaluare.Show vbModeless
End Sub
Sub InsertNewRow()
Dim rCell As Range
Dim rRow As Range
Dim rList As Range
Dim nRow As Long
Dim row As Range
Dim neValues As Range
Dim neFormulas As Range
Dim MyRange As Range
ActiveSheet.Unprotect "13021429"
nRow = Val(InputBox("Introduceti numarul liniei sub care doriti sa se face inserarea." & vbNewLine & " " & vbNewLine & "ATENTIE!" & vbNewLine & "Este vorba despre numarul liniei din Excel nu despre numarul curent din tabel.", "Introducere date"))
If nRow = 0 Then Exit Sub
Set rRow = Intersect(ActiveSheet.Cells(nRow, 1).EntireRow, ActiveSheet.UsedRange)
If rRow Is Nothing Then Exit Sub
rRow.EntireRow.Select
If rRow.MergeCells Then
MsgBox "Actiune nepermisa." & vbCrLf & "Linia selectata contine celule comasate (merged cells)."
rRow.Offset(1, 0).Cells(0, 1).Select
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Exit Sub
End If
Set rCell = rRow.Offset(1, 0).Cells(0, 1)
If rCell.Value = "Nr. crt." Then
MsgBox "Actiune nepermisa." & vbCrLf & "Nu puteti introduce un nou cap de tabel."
rRow.Offset(2, 0).Cells(0, 2).Select
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Exit Sub
End If
Set MyRange = Columns("B:K")
On Error Resume Next
Set neValues = Intersect(ActiveCell.EntireRow.SpecialCells(xlConstants), MyRange)
Set neFormulas = Intersect(ActiveCell.EntireRow.SpecialCells(xlFormulas), MyRange)
On Error GoTo 0
If neValues Is Nothing And neFormulas Is Nothing Then
MsgBox "Nu puteti introduce o linie noua sub o linie lipsita de continut."
rRow.Offset(-1, 0).Cells(1, 0).Select
Else
rRow(1).Offset(1, 0).EntireRow.Insert
rRow.Copy rRow.Cells(1).Offset(1, 0)
Application.CutCopyMode = False
Set rCell = rRow.Cells(1).Offset(1, 0).Resize(1, rRow.Columns.Count)
On Error Resume Next
rCell.SpecialCells(xlCellTypeConstants).ClearContents
rRow.Offset(0, 1).Cells(1, 0).Select
On Error GoTo 0
Set rCell = Nothing
Set rRow = Nothing
End If
ActiveWindow.DisplayGridlines = False
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
Sub DeleteRow()
Dim firstrw As Long
ActiveSheet.Unprotect "13021429"
If firstrw = 0 Then
firstrw = Application.InputBox(prompt:="Indicati numarul liniei pe care doriti sa o stergeti." & vbNewLine & "" & vbNewLine & "ATENTIE!" & vbNewLine & "Este vorba despre numarul liniei din Excel nu despre numarul curent din tabel." _
, Title:="Stergere date", Default:="")
If firstrw = False Then Exit Sub
End If
Cells(firstrw, "A").Select
ActiveCell.EntireRow.Delete
ActiveSheet.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub
Sub Print_Active_Worksheet()
Application.DisplayFullScreen = False
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="13021429"
With ActiveSheet
lr = .Range("B" & Rows.Count).End(xlUp).row
.PageSetup.PrintArea = "B2:K" & lr
'.PrintOut
.PrintPreview
End With
ActiveSheet.Protect Password:="13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingRows:=True, AllowFormattingCells:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Application.EnableEvents = True
Application.DisplayFullScreen = True
End Sub
Sub HideStuff()
Application.DisplayFullScreen = True
Application.DisplayFormulaBar = False
ActiveWindow.DisplayWorkbookTabs = False
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = False
End Sub
Sub ShowStuff()
Application.DisplayFullScreen = False
Application.DisplayFormulaBar = True
ActiveWindow.DisplayWorkbookTabs = True
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayGridlines = True
End Sub
Sub ProtectAllCells()
' Face lock la toate celulele din activesheet
' Suprima selectarea
Dim sh As Worksheet
On Error Resume Next
For Each sh In ActiveWorkbook.Sheets
sh.Unprotect "13021429"
Application.CutCopyMode = False
sh.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True
sh.EnableSelection = xlNoSelection
Next sh
End Sub
Sub UnprotectAllCells()
Dim sh As Worksheet
On Error Resume Next
For Each sh In ActiveWorkbook.Sheets
sh.Unprotect "13021429"
Application.CutCopyMode = True
sh.Protect "13021429", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingRows:=True
sh.EnableSelection = xlUnlockedCells
Next sh
End Sub