-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Fferi50
Topikgazda
válasz
Zola007
#41043
üzenetére
Szia!
Ezt az adott munkalap kódlapjára kell bemásolnod:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 1 Then Exit Sub
Dim cmt As Comment
Application.EnableEvents = False
Set cmt = Target.Comment
If Not cmt Is Nothing Then Target.Comment.Delete
If Target.Value <> "" Then Target.AddComment Target.Value Else Application.EnableEvents = True: Exit Sub
Set cmt = Target.Comment
With cmt
.Visible = True
.Shape.TextFrame.AutoSize = True
.Visible = False
End With
Application.EnableEvents = True
End SubAz előző Selection_Change makrót kitörölheted.
Mit csinál a makró?
Most az A (első) oszlop celláira működik, ha másik oszlopban vannak az adatok, akkor annak a számát íd be az 1 helyére.
Amikor megváltoztatod egy cella értékét, akkor azt az értéket beteszi megjegyzésbe is, amit egy kis piros jelölő mutat majd a cella jobb felső sarkában. A megjegyzés úgy viselkedik, ahogyan az elején írtad, ha az egérrel rámutatsz a cellára, a megjegyzés "kibomlik" és addig látható, amíg az egérmutató ott van.
Viszont ahhoz, hogy a makró szolgáltatását "élvezhesd", egyszer végig kell menned az adott oszlopon "enterekkel", hogy a Change esemény létrejöjjön.
Ha ezt túl soknak találod, akkor másold be ezt a makrót egy Modul lapra (de az sem nagy baj, ha a munkalap kódlapjára másolod):Sub megjegyzes()
Dim cl As Range, cmt As Comment
Application.EnableEvents = False
For Each cl In ActiveSheet.UsedRange.Columns("A").Cells
Set cmt = cl.Comment
If Not cmt Is Nothing Then cl.Comment.Delete
If cl.Value <> "" Then
cl.AddComment cl.Value
Set cmt = cl.Comment
With cmt
.Visible = True
.Shape.TextFrame.AutoSize = True
.Visible = False
End With
End If
Next
Application.EnableEvents = True
End Sub
Ez végigmegy az A oszlopon és felteszi a megjegyzéseket oda, ahol a cellában érték van. Természetesen az A oszlopot változtasd át a neked megfelelőre.Tehát először lefuttatod a második makrót - majd az első követi a változásokat az oszlopban.
Üdv.
Új hozzászólás Aktív témák
- Ableton Live 12 Suite Education
- Game Pass Ultimate előfizetések 3 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- PC Szervizeket, Gépépítőket keresek B2B szoftver partnerségre (E-számlával)
- Kaspersky, BitDefender, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- 5G! Lenovo ThinkPad P14s Gen 4 Intel Core i7-1370P RTX A500 32GB 1000GB 1 év teljeskörű garancia
- BESZÁMÍTÁS! Gigabyte B450M R5 3600X 32GB DDR4 512GB SSD RTX 3060 12GB NZXT Source 340 Bitfenix 550W
- Surface 3 - 13,5" 2k érintő, i5 1035G7, Iris Plus, 16GB RAM, SSD, jó akku, újszerű állapot, számla
- Apple iPhone 17 Pro 512GB & 1TB Bontatlan Független Összes Szín / 27% áfás ár
- 277 - Lenovo Legion Pro 7 (16IAX10H) - Intel Core U9 275HX, RTX 5080
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50