VBATools

Połączenie wielu komentarzy przy scaleniu komórek

by on Sep.26, 2011, under Excel, Porady

W przypadku kiedy chcemy połączyć wiele komórek, które mają wpisany komentarz, jesteśmy narażeni na utratę ich części.

Poniższe makro pobierze komentarze i połączy je w jeden z zachowaniem właściciela komentarza.

Option Explicit

Sub AllComment_AfterMargeCells()
'MVP OShon from VBATools.pl
Dim r As Range, coment As String, com As Comment, user$
For Each r In Selection
On Error Resume Next
 If Len(r.Comment.Text) > 0 Then
  If InStr(1, r.Comment.Text, Chr(10)) > 0 Then
   user = Split(r.Comment.Text, Chr(10))(0)
   coment = coment + Mid(r.Comment.Text, _
   InStr(1, r.Comment.Text, Chr(10)))
  Else
   coment = coment + r.Comment.Text
  End If
  coment = Replace(coment, Chr(10) & Chr(10), Chr(10))
 End If
Next r
On Error GoTo 0
Application.DisplayAlerts = False
 Selection.Merge
 With ActiveCell
  On Error Resume Next
  .Comment.Delete
  On Error GoTo 0
  .AddComment.Shape.SetShapesDefaultProperties
  .Comment.Text user & coment
  With .Comment.Shape.TextFrame
   .Characters(1, Len(coment & user)).Font.Bold = False
   .Characters(1, Len(user)).Font.Bold = True
  End With
 End With
End Sub

XL_Połączenie_wielu_komentarzy_przy_scaleniu_komórek

Rys.1 Efekt przed i po zastosowaniu pow. kodu.

Polecamy zainteresowanym rozwiązanie w formie dodatku: Zarządzanie komentarzami w Excelu

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.

:, , ,

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała