< návrat zpět

MS Excel


Téma: Komentář - odkaz na buňku rss

Zaslal/a 23.10.2014 3:36

Dobrý den.
Prosím o radu jak do komentáře dostat text z buňky na stejném listu. Tento text v buňce se bude měnit a automaticky by se měl měnit i v komentáři.
V příloze sešit a do komentářů ve sloupci C2:C13 potřebuji dostat text z buněk ve sloupci H2:H13
Předem děkuji za radu.

Příloha: 7z21992_komentar.7z (15kB, staženo 27x)
Zaslat odpověď >

#021993
avatar
Vlož do modulu příslušného listu ve VBA (alt+f11)

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cmt As Comment, strCmt As String
Dim bigRange As Range

Set bigRange = Range("H2:H13")

If Not Intersect(Target, bigRange) Is Nothing Then
With Target.Offset(0, -5)
.ClearComments

strCmt = Target.Value

Set Cmt = .AddComment(strCmt)

With Cmt.Shape.TextFrame
.Characters.Font.Bold = False
.AutoSize = True
End With 'Cmt.Shape.TextFrame
End With 'Target.Offset
End If
End Sub
citovat
#022001
avatar
Děkuji - to je přesně co jsem potřeboval.
Akorát mám problém s tím, že buňku s komentářem mám zamknutou a tak to nefunguje. Dále když chci zdrojové buňky vymazat (DEL) - naskočí error 13. Poslední problém je ten, že se komentář nezalamuje a při dlouhém textu (ten budu mít někdy hodně dlouhý) je rámeček komentáře mimo obrazovku.
Prosím nešlo by ještě s tímto něco udělat ? Já jsem na to deb..
Přiložil jsem ještě jednou přílohu (list je zamknutý bez hesla)
Děkuji
Příloha: 7z22001_komentar.7z (17kB, staženo 35x)
citovat
#022002
avatar
Trochu jsem upravil kod.
Nastav si heslo (zde "a") a pokud nebude vyhovovat šířka tak i s tím (zde 200)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim PASSWORD As String

PASSWORD = "a"
ActiveSheet.Unprotect PASSWORD

Dim Cmt As Range
Dim bigRange As Range
Dim lArea As Long

Set bigRange = Range("H2:H22")

If Not Intersect(Target, bigRange) Is Nothing Then

Set Cmt = Target
With Cmt.Offset(0, -5)
.ClearComments
If Not IsEmpty(Target) Then

.AddComment.Text Text:=Cmt.Value

With .Comment.Shape
.TextFrame.Characters.Font.Bold = False
.TextFrame.AutoSize = True

If .Width > 300 Then
lArea = .Width * .Height
.Width = 200
' An adjustment factor of 1.1 seems to work ok.
.Height = (lArea / 200) * 1.1
End If
End With 'Cmt.Shape
End If
End With 'Cmt.Offset
End If
ActiveSheet.Protect PASSWORD
End Sub
citovat
#022027
avatar
superrr - takto přesně jsem to chtěl - moc, moc děkuji 9citovat

Uživatelské menu

Nejste přihlášen(a)
avatar\n

Menu

On-line nástroje

Formulář Faktura

Formulář Faktura IV

Oblíbený formulář Faktura byl vylepšen a rozšířen.
Více se dočtete zde.

Aktivní diskuse