Forum di Excel e VBA, per condividere esperienze e risolvere problemi su:
Excel, Word, Access, Power Point, Microsoft Office, macro, Visual Basic e Visual Studio.
Impostazioni commento
- Hai un problema con Excel?
Impostazioni commento
di DPG70 (utente non iscritto) data: 03/03/2016 20:12:28
Buona sera,
apro questa discussione per ottenere delle informazioni sulla modifica con applicazione vba, del carattere inserito in un commento alla cella.
Es. vedi codice allegato.
Non trovo istruzioni di codice per modificare le impostazioni del carattere di un commento: font, misure, colore, ecc...
Nemmeno il registratore, mi ha indicato la scrittura!
Si puo fare?
If Not Intersect(Target, Range("BB10:BB5000")) Is Nothing Then ActiveCell(1, -24).Select ActiveCell.ClearComments If Target <> "" Then ActiveCell.Select With ActiveCell.AddComment .Text Text:=" << Controlla >> " & Chr(10) & "le annotazioni presenti" & Chr(10) & " con un doppio click" .Shape.ScaleWidth 0.95, msoFalse, msoScaleFromTopLeft .Shape.ScaleHeight 0.75, msoFalse, msoScaleFromTopLeft End With ElseIf Target = "" Then ActiveCell(1, -24).ClearComments End If End If
di isy data: 03/03/2016 21:07:09
Ciao
Prova così, da adattare alle tue esigenze
Sub test() Dim r As Integer Dim xRange As Range '* Add Comment: For Each xRange In Selection With xRange .ClearComments .AddComment "Test" & Chr(10) & "Valore cella= " & xRange.Value .Comment.Visible = True .Comment.Shape.AutoShapeType = msoShapeRoundedRectangle .Comment.Shape.TextFrame.Characters.Font.Name = "Tahoma" .Comment.Shape.TextFrame.Characters.Font.Size = 8 .Comment.Shape.TextFrame.Characters.Font.ColorIndex = 2 .Comment.Shape.Line.ForeColor.RGB = RGB(0, 0, 0) .Comment.Shape.Line.BackColor.RGB = RGB(255, 255, 255) .Comment.Shape.Fill.Visible = msoTrue .Comment.Shape.Fill.ForeColor.RGB = RGB(58, 82, 184) .Comment.Shape.Fill.OneColorGradient msoGradientDiagonalUp, 1, 0.23 'font size Attribute .Comment.Shape.TextFrame.Characters(1, 1).Font.Color = vbRed .Comment.Shape.TextFrame.Characters(6, 6).Font.Color = vbYellow .Comment.Shape.TextFrame.Characters(1, 1).Font.Size = 24 .Comment.Shape.TextFrame.Characters(6, 6).Font.Size = 12 End With Next xRange End Sub
di DPG70 (utente non iscritto) data: 03/03/2016 23:32:26
Io avevo provato questo codice...
ma il tuo commento Isy "wuauu" impatto visivo e informazioni a me interessanti.
Dal tuo: .AddComment "Test" & Chr(10) & "Valore cella= " & xRange.Value
Se volessi collegare al nuovo commento visualizzato nel campo AC del mio codice, il valore stringa presente nella cella del campo BB e autodimensionare il riquadro del commento?
Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("AX10:AX5000")) Is Nothing Then If Target = "SI" Then Target = "NO" ElseIf Target = "NO" Then Target = "SI" End If If Target = "SI" Then ActiveCell(1, -2).Select Selection.Copy ActiveCell(1, -2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ElseIf Target = "NO" Then ActiveCell(1, -5).Select Selection.ClearContents End If End If If Not Intersect(Target, Range("AC10:AC5000")) Is Nothing Then ActiveCell(1, 26).Select End If If Not Intersect(Target, Range("BB10:BB5000")) Is Nothing Then ActiveCell(1, -24).Select ActiveCell.ClearComments If Target <> "" Then ActiveCell.Select With ActiveCell.AddComment .Visible = False .Text Text:=" << Controlla >> " & Chr(10) & "le annotazioni presenti" & Chr(10) & " con un doppio click" .Shape.ScaleWidth 0.72, msoFalse, msoScaleFromTopLeft .Shape.ScaleHeight 0.47, msoFalse, msoScaleFromTopLeft End With With ActiveCell.Comment.Shape.TextFrame.Characters.Font .Name = "Tahoma" .Size = 7 .Bold = False .Italic = False '.Color = RGB(0, 0, 255)'<< Blu or (255,0,0)<< Rosso (0,153,76) << Verde scuro (128,0,0) << Marrone .Color = vbBlue End With ElseIf Target = "" Then ActiveCell(1, -24).ClearComments End If End If End Sub
di DPG70 (utente non iscritto) data: 06/03/2016 11:13:17
Ad oggi sono arrivato a questa mia articolata e spartana soluzione.
Applicando al foglio questi due codici: il primo per restituirmi il numero di riga selezionato;
l'altro basandosi sul primo, applicare al commento nella riga selezionata il valore di un'altra cella della stessa riga.
Vorrei semplificare al massimo i tempi di esecuzione e questa mia soluzione direi è poco comoda.
Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Cells) Is Nothing Then Range("D1").Value = Target.Row End If End Sub Sub ImpostaCommento() Dim r As Integer Dim xRange As Range r = Cells(1, 4).Value '* Add Comment: For Each xRange In Selection With xRange .ClearComments .AddComment "Annotazioni presenti:" & Chr(10) & Cells(r, 54).Value .Comment.Visible = False .Comment.Shape.AutoShapeType = msoShapeRoundedRectangle .Comment.Shape.TextFrame.Characters.Font.Name = "Tahoma" .Comment.Shape.TextFrame.Characters.Font.Size = 6 .Comment.Shape.TextFrame.Characters.Font.ColorIndex = 2 .Comment.Shape.Line.ForeColor.RGB = RGB(0, 0, 0) .Comment.Shape.Line.BackColor.RGB = RGB(255, 255, 255) .Comment.Shape.Fill.Visible = msoTrue .Comment.Shape.Fill.ForeColor.RGB = RGB(58, 82, 184) .Comment.Shape.Fill.OneColorGradient msoGradientDiagonalUp, 1, 0.23 .Comment.Shape.TextFrame.Characters(1, 1).Font.Color = vbRed .Comment.Shape.TextFrame.Characters(2, 20).Font.Color = vbYellow .Comment.Shape.TextFrame.Characters(1, 1).Font.Size = 9 .Comment.Shape.TextFrame.Characters(2, 20).Font.Size = 8 .Comment.Shape.ScaleWidth 0.95, msoFalse, msoScaleFromTopLeft .Comment.Shape.ScaleHeight 0.95, msoFalse, msoScaleFromTopLeft End With Next xRange End Sub
di isy data: 06/03/2016 12:52:39
Ciao
Ho creato un ciclo con DoubleClick
Prova il nuovo ciclo
Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.EnableEvents = False Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayAlerts = False Application.DisplayStatusBar = False ActiveSheet.DisplayPageBreaks = False Dim xRange As Range '* Add Comment: For Each xRange In Selection With xRange .ClearComments .AddComment "Annotazioni presenti:" & Chr(10) & Cells(Target.Row, 54).Value .Comment.Visible = False .Comment.Shape.AutoShapeType = msoShapeRoundedRectangle .Comment.Shape.TextFrame.Characters.Font.Name = "Tahoma" .Comment.Shape.TextFrame.Characters.Font.Size = 6 .Comment.Shape.TextFrame.Characters.Font.ColorIndex = 2 .Comment.Shape.Line.ForeColor.RGB = RGB(0, 0, 0) .Comment.Shape.Line.BackColor.RGB = RGB(255, 255, 255) .Comment.Shape.Fill.Visible = msoTrue .Comment.Shape.Fill.ForeColor.RGB = RGB(58, 82, 184) .Comment.Shape.Fill.OneColorGradient msoGradientDiagonalUp, 1, 0.23 .Comment.Shape.TextFrame.Characters(1, 1).Font.Color = vbRed .Comment.Shape.TextFrame.Characters(2, 20).Font.Color = vbYellow .Comment.Shape.TextFrame.Characters(1, 1).Font.Size = 9 .Comment.Shape.TextFrame.Characters(2, 20).Font.Size = 8 .Comment.Shape.ScaleWidth 0.95, msoFalse, msoScaleFromTopLeft .Comment.Shape.ScaleHeight 0.95, msoFalse, msoScaleFromTopLeft .Comment.Shape.TextFrame.AutoSize = True End With Next xRange Application.Calculation = xlCalculationAutomatic Application.DisplayStatusBar = True Application.ScreenUpdating = True Application.EnableEvents = True Cancel = True ActiveCell.Select End Sub
di DPG70 (utente non iscritto) data: 06/03/2016 14:26:15
Ho già un ciclo con DoubleClick nel foglio che mi crea interferanza, allego le macro collegate presenti per chiarire.
Immagino che le seguenti scritture siano per velocizzare i cicli, conosco le prime tre mentre le altre mi sono nuove, cercherò.
-------------------------------------------------------------
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
------------------------------------------------------------
Volevo capire se fosse possibile eliminare il codice Private Sub Worksheet_SelectionChange(ByVal Target As Range) inserendo della scrittura direttamente negli altri codici, oppure queste e la soluzione più chiara, veloce e semplice.
Avendo molte macro nella cartella, cercavo di snellire il più possibile. Grazie.
Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, Cells) Is Nothing Then Range("D1").Value = Target.Row End If End Sub ------------------------------------------------------------------------------------------------- Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'con doppio click su una cella della colonna scelta modifica il valore contenuto 'se "Si" in "No" altrimenti se "No" in "Si" fissando con la conferma 'il valore unitario nella cella del prezzo a mano. If Not Intersect(Target, Range("AX10:AX5000")) Is Nothing Then If Target = "SI" Then Target = "NO" ElseIf Target = "NO" Then Target = "SI" End If If Target = "SI" Then ActiveCell(1, -2).Select Selection.Copy ActiveCell(1, -2).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ElseIf Target = "NO" Then ActiveCell(1, -5).Select Selection.ClearContents End If End If If Not Intersect(Target, Range("AC10:AC5000")) Is Nothing Then ActiveCell(1, 26).Select End If If Not Intersect(Target, Range("BB10:BB5000")) Is Nothing Then ActiveCell(1, -24).Select ActiveCell.ClearComments If Target <> "" Then ActiveCell.Select Call ImpostaCommento ElseIf Target = "" Then ActiveCell(1, -24).ClearComments End If End If End Sub ------------------------------------------------------------------------------------------------ Sub ImpostaCommento() 'Application.EnableEvents = False 'Application.Calculation = xlCalculationManual 'Application.ScreenUpdating = False 'Application.DisplayAlerts = False 'Application.DisplayStatusBar = False 'ActiveSheet.DisplayPageBreaks = False Dim r As Integer Dim xRange As Range r = Cells(1, 4).Value '* Add Comment: For Each xRange In Selection With xRange .ClearComments .AddComment " Annotazioni presenti: " & Chr(10) & Cells(r, 54).Value .Comment.Visible = False .Comment.Shape.AutoShapeType = msoShapeRoundedRectangle .Comment.Shape.TextFrame.Characters.Font.Name = "Tahoma" .Comment.Shape.TextFrame.Characters.Font.Size = 6 .Comment.Shape.TextFrame.Characters.Font.ColorIndex = 2 .Comment.Shape.Line.ForeColor.RGB = RGB(255, 135, 0) .Comment.Shape.Line.BackColor.RGB = RGB(255, 255, 255) .Comment.Shape.Fill.Visible = msoTrue .Comment.Shape.Fill.ForeColor.RGB = RGB(58, 82, 184) .Comment.Shape.Fill.OneColorGradient msoGradientDiagonalUp, 1, 0.23 'Font size Attribute: .Comment.Shape.TextFrame.Characters(1, 2).Font.Color = RGB(255, 0, 25) 'RGB(255, 175, 0) 'Arancione .Comment.Shape.TextFrame.Characters(3, 21).Font.Color = RGB(255, 255, 0) 'or vbYellow .Comment.Shape.TextFrame.Characters(1, 2).Font.Size = 9 .Comment.Shape.TextFrame.Characters(3, 21).Font.Size = 8 .Comment.Shape.ScaleWidth 0.95, msoFalse, msoScaleFromTopLeft .Comment.Shape.ScaleHeight 0.95, msoFalse, msoScaleFromTopLeft End With Next xRange 'Application.Calculation = xlCalculationAutomatic 'Application.DisplayStatusBar = True 'Application.ScreenUpdating = True 'Application.EnableEvents = True End Sub
di DPG70 (utente non iscritto) data: 10/03/2016 21:43:53
Anche se non ho ricevuto in questi giorni risposte alla mia ultima richiesta specifica qui riportata, ritengo la discussione nella mia domanda iniziale RISOLTA_ Grazie!
------------------------------------------------------------------------------------------------------------------------------------------
( Volevo capire se fosse possibile eliminare il codice Private Sub Worksheet_SelectionChange(ByVal Target As Range) inserendo della scrittura direttamente negli altri codici, oppure queste e la soluzione più chiara, veloce e semplice.
Avendo molte macro nella cartella, cercavo di snellire il più possibile.)
- Vuoi Approfondire?
