Pagina precedente | 1 | Pagina successiva
Vota | Stampa | Notifica email    
Autore

Problema con Protect e Unprotect nella stessa macro

Ultimo Aggiornamento: 03/09/2017 17:23
Post: 1
Registrato il: 31/08/2017
Città: MILANO
Età: 32
Utente Junior
2013 Professional Plus
OFFLINE
02/09/2017 18:23

Ciao a tutti! Premetto che mi sto cimentando soltanto da poco nella realizzazione di macro, quindi mi scuso anticipatamente per possibili castronerie. Nel voler creare combo box e poter filtrare dati da una lista, nella macro utilizzata nel foglio di lavoro dovrei poter sbloccare e ribloccare lo stesso per poter filtrare digitando appunto nella cella. Il mio codice è questo (copiato in giro):

'==========================
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
ActiveSheet.Unprotect Password:="Italia92a"

Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains
'a data validation list
Cancel = True
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = str
.LinkedCell = Target.Address
End With
cboTemp.Activate
'open the drop down list automatically
Me.TempCombo.DropDown
End If

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub
'=========================================

Private Sub TempCombo_LostFocus()
With Me.TempCombo
.Top = 10
.Left = 10
.Width = 0
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
ActiveSheet.Unprotect Password:="Italia92a", Contents:=False

End Sub
'====================================


'====================================
'Optional code to move to next cell
'if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems,
'change to KeyUp
'Table with numbers for other keys
'such as Right Arrow (39)
'https://msdn.microsoft.com/en-us/


Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)

Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
'====================================

Non riesco a sbloccarlo e ribloccarlo, qualcuno può aiutarmi??
Post: 1.589
Registrato il: 06/04/2013
Utente Veteran
2010
OFFLINE
03/09/2017 17:23

Ciao
non è semplice risponderti senza il file di esempio.

"A naso":
nella Private Sub Worksheet_BeforeDoubleClick...
dovresti riproteggere il foglio, inserendo:

ActiveSheet.Protect Password:="Italia92a"

verso la fine:
errHandler:
ActiveSheet.Protect Password:="Italia92a"
Application.EnableEvents = True
Exit Sub
End Sub

nella Private Sub TempCombo_LostFocus()
mi "sembra" inutile:
ActiveSheet.Unprotect Password:="Italia92a", Contents:=False
quindi lo toglierei

nella Private Sub TempCombo_KeyDown....
non vedrei necessità di fare nulla.

...ma ripeto è tutto da vedere su un esempio concreto.

saluti


[Modificato da dodo47 03/09/2017 17:25]
Domenico
Win 10 - Excel 2016
Vota:
Amministra Discussione: | Chiudi | Sposta | Cancella | Modifica | Notifica email Pagina precedente | 1 | Pagina successiva
Nuova Discussione
 | 
Rispondi
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Feed | Forum | Bacheca | Album | Utenti | Cerca | Login | Registrati | Amministra
Tutti gli orari sono GMT+01:00. Adesso sono le 11:30. Versione: Stampabile | Mobile | Regolamento | Privacy
FreeForumZone [v.6.1] - Copyright © 2000-2024 FFZ srl - www.freeforumzone.com