Moderatori: Anthony47, Flash30005
Con questa modifica controlliamo che la riga 4 della colonna selezionata contenga un numero tra 1 e 31:sarebbe interessante provare magari a far eseguire il codice soltanto sulla griglia di celle che riguardano i giorni del mese
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If IsError(Application.Match(Sh.Name, Array("Dati", "Riepilogo", "Foglio1"), False)) Then
If IsNumeric(Cells(4, Target.Column)) Then
If Cells(4, Target.Column) >= 1 And Cells(4, Target.Column) < 32 Then
Sh.Unprotect "pippo12"
Cancel = True
Call Commento
Sh.Protect "pippo12"
End If
End If
End If
End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If IsError(Application.Match(Sh.Name, Array("Dati", "Riepilogo", "Foglio1"), False)) Then
If IsDate(Cells(4, Target.Column)) Then '<<< IsDate e non IsNumeric
' If Cells(4, Target.Column) >= 1 And Cells(4, Target.Column) < 32 Then
Sh.Unprotect "pippo12"
Cancel = True
Call Commento
Sh.Protect "pippo12"
' End If
End If
End If
End Sub
Sub Commento()
On Error Resume Next
ActiveCell.AddComment
On Error GoTo 0
ActiveCell.Comment.Visible = False
ActiveCell.Comment.Text Text:="inviata: " & Now()
Range("A1").Select
End Sub
Call CommentoDue
Sub CommentoDue()
Dim ccTxt As String, nxTxt
'
On Error Resume Next
ccTxt = ActiveCell.Comment.Text
On Error GoTo 0
'
If Len(ccTxt) > 0 Then
nxTxt = Application.InputBox("Commento da Aggiungere", "Gestione Commento", , , , , , 2)
If nxTxt <> False Then
ActiveCell.Comment.Text ccTxt & Chr(10) & "> " & Replace(nxTxt, "§", Chr(10), , , vbTextCompare) & " - " & Now()
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Shape.Select True
Selection.AutoSize = True
MsgBox ("Fatto")
ActiveCell.Comment.Visible = False
End If
Else
ActiveCell.AddComment
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Text Text:="Inviata: " & Now()
ActiveCell.Comment.Shape.Select True
Selection.AutoSize = True
ActiveCell.Comment.Visible = False
Range("A1").Select
End If
End Sub
> Commento aggiunto
su due righe 20/05/2023 15:20
Sub Cancellagriglia()
ActiveSheet.Unprotect "pippo12"
Range("B5:AF41").Select
Dim Rispo
Rispo = MsgBox("Confermi la pulizia dell'area Dati del foglio?", vbYesNo)
If Rispo <> vbYes Then
Beep
Else
Selection.ClearComments
Selection.ClearContents
End If
ActiveSheet.Protect "pippo12"
Range("A1").Select
End Sub
Torna a Applicazioni Office Windows
Macro per aprire file salvato su sharepoint Onedrive Autore: marcopont |
Forum: Applicazioni Office Windows Risposte: 2 |
Importare immagini a seconda del testo in una cella Autore: Paolo67met |
Forum: Applicazioni Office Windows Risposte: 4 |
Come interrompere macro sndPlaySound Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Inserire valore di una cella in altra cella con testo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 17 |
Visitano il forum: Nessuno e 16 ospiti