Tekst in opmerkingen vervangen

[turbifreak]

Een probleem waarvoor ik nog geen oplossing heb gevonden.

Ik heb een Excelsheet met een 2000-tal opmerkingen, waarin 2 regels tekst staan. Nu zou ik bepaalde woorden die voorkomen in alle opmerkingen willen vervangen, wat CTRL+F Vervangen eigenlijk doet, maar dat werkt dus niet voor opmerkingen.

Iemand een idee?

Alvast bedankt !

 

[gast0660]

Het kan zo

Sub Dotchie
Dim cmt As Comment
Dim wks As Worksheet
Dim sFind As String
Dim sReplace As String
Dim sCmt As String
sFind = "[COLOR="#FF0000"]Oud woord[/COLOR]"
sReplace = "[COLOR="#FF0000"]Nieuw woord[/COLOR]"
For Each wks In ActiveWorkbook.Worksheets
For Each cmt In wks.Comments
sCmt = cmt.Text
If InStr(sCmt, sFind) <> 0 Then
sCmt = Application.WorksheetFunction. _
Substitute(sCmt, sFind, sReplace)
cmt.Text Text:=sCmt
End If
Next
Next
Set wks = Nothing
Set cmt = Nothing
End Sub

 

[turbifreak]

Super ! Dit helpt, bedankt.

Het geeft alleen een schoonheidsfoutje bij mij. Omdat de eerste regel tekst in de opmerking cursief staat en het vervangen gebeurt met tekst die op de tweede regel staat (die niet cursief is), zijn de vervangen woorden (en alles wat erachter komt) ineens cursief. Hoe kan ik ervoor zorgen dat de vervangen tekst niet in het cursief gezet wordt, dus dat dat niet overgenomen wordt van de eerste regel?

 

[gast0660]

Hoi,

Sub Dotchie()
Dim cmt As Comment
Dim wks As Worksheet
Dim sFind As String
Dim sReplace As String
Dim sCmt As String
Dim xComment As Comment
sFind = "2016"
sReplace = "2017"
For Each wks In ActiveWorkbook.Worksheets
For Each cmt In wks.Comments
sCmt = cmt.Text

If InStr(sCmt, sFind) <> 0 Then
sCmt = Application.WorksheetFunction. _
Substitute(sCmt, sFind, sReplace)
cmt.Text Text:=sCmt
End If
Next
Next
Set wks = Nothing
Set cmt = Nothing
Dim xWs As Worksheet

For Each wks In Application.ActiveWorkbook.Worksheets
    For Each xComment In wks.Comments
        With xComment.Shape.TextFrame.Characters.Font
        .Italic = False
        End With
    Next
Next

 

[VenA]

Ik dacht zo

Sub VenA()
For Each cl In Cells.SpecialCells(-4144)
  With cl.Comment
    .Text Replace(.Text, "Oude tekst", "Nieuwe tekst")
    .Shape.TextFrame.Characters.Font.Italic = False
  End With
Next
End Sub

 

[turbifreak]

Het vervangen werkt prima en in beide gevallen is de vervangen tekst ook niet meer cursief, maar is de eerste regel (die wel cursief dient te blijven en waar nooit iets vervangen wordt) nu ook niet meer cursief...

Is het mogelijk om enkel de vervangen tekst niet in het cursief te laten verschijnen? Hij neemt het cursief zijn over omdat de regel erboven cursief is, en de vervangen tekst altijd vooraan op regel 2 staat.

 

[VenA]

Zo beter?

Sub VenA()
For Each cl In Cells.SpecialCells(-4144)
  With cl.Comment
    .Text Replace(.Text, "Oude tekst", "Nieuwe tekst")
    .Shape.TextFrame.Characters.Font.Italic = False
    .Shape.TextFrame.Characters(1, Len(Split(.Text, Chr(10))(0))).Font.Italic = True
  End With
Next
End Sub

 

[turbifreak]

Schitterend, zo lukt het .

Hartelijk dank aan beiden !

 

[HSV]

Zo kan het ook.

.Shape.TextFrame.Characters(1, Len(.author) + 1).Font.Italic = True

..mits de eerste regel de auteur is.