Opmerking in cel maken en vervolgens tekst uit een range hierin plaatsen.

[HarryBee]

Beste helpers,

Ik zit met de volgende vraag: Via een userform laat ik tekst plaatsen in een range Blad4!A1:C17. Wat ik wil is op blad 1 automatisch een comment plaatsen die gevuld wordt met de gegevens uit de range Blad4!A1:C17.
Weet iemand een oplossing?

Sub Comment()
Dim tx As Range
Set tx = [Blad4!A1:C17]
If Not Range("A2").Comment Is Nothing Then
        Range("A2").Comment.Delete
    End If
    Range("A2").AddComment
    Range("A2").Comment.Visible = False
    Range("A2").Comment.Text tx 'Text:=tx   
    Range("A2").Comment.Shape.ScaleWidth 1.52, msoFalse, msoScaleFromTopLeft
    Range("A2").Comment.Shape.ScaleHeight 2.09, msoFalse, msoScaleFromTopLeft
 
End Sub

Helaas werkt deze code niet. Ik vergeet zeker wat, maar loop hierop vast.

Alvast mijn dank.

Groet Harry

 

[sylvester-ponte]

maak nog een string aan waar je met een loopje alle tekst cel voor cel uit range tx in zet.
en voeg die string verderop aan je comment toe

 

[Cobbe]

Zo iets misschien:

Sub Comment()
Dim tx As Range
For i = 14 To 17
  commentaar = commentaar & Sheets("Blad4").Cells(i, 3)
Next
If Not Range("A2").Comment Is Nothing Then
        Range("A2").Comment.Delete
    End If
    Range("A2").AddComment
    Range("A2").Comment.Visible = True
    Range("A2").Comment.Text Text:=commentaar
    Range("A2").Comment.Shape.ScaleWidth 1.52, msoFalse, msoScaleFromTopLeft
    Range("A2").Comment.Shape.ScaleHeight 2.09, msoFalse, msoScaleFromTopLeft
 
End Sub

 

[HarryBee]

Sylvester Ponten,

Dank voor je reactie. Ik ga het eerst even proberen.
Groet Harry

 

[HarryBee]

Cobbe,

Dank voor de aangedragen oplossing. Op zich werkt de code, alleen wordt de info uit de genoemde range, aan één stuk in de opmerking vermeld. De gegevens op blad 4 A1:C17 moet je zien als een formulieropmaak. Het is eigenlijk de bedoeling dit een op een over te zetten. Dus ook in dezelfde opmaak of volgorde. Zou dat te regelen zijn?

Groet Harry

 

[Cobbe]

Zo dan:

Sub Comment()
Dim tx As Range
 For i = 14 To 17
   commentaar = commentaar & Chr(10) & Sheets("Blad4").Cells(i, 3)
 Next
  If Not Range("A2").Comment Is Nothing Then
        Range("A2").Comment.Delete
  End If
    Range("A2").AddComment
    Range("A2").Comment.Visible = True
    Range("A2").Comment.Text Text:=commentaar
End Sub

 

[HarryBee]

Cobbe,

Ik plaats een bestandje. Misschien is het zo wat duidelijker. In ieder geval dank voor je hulp.

Groet HarryBekijk bijlage Helpmij Comment.xlsm

 

[sylvester-ponte]

je kan zelf instellen waar het vandaan moet komen door de range intestellen

Sub Comment()
Dim tx As Range
Set tx = Range("Blad4!A1:C17")
For rij = 1 To tx.Rows.Count
    For kolom = 1 To tx.Columns.Count
        commentaar = commentaar & tx(rij, kolom) & "  "
    Next kolom
    commentaar = commentaar & Chr(10)
Next rij
    Range("A2").NoteText commentaar
End Sub

 

[Cobbe]

Om die cellen MET opmaak in een opmerking te zetten zal ook wel mogelijk zijn maar nogal omslachtig denk ik zo.
Je kan die cellen kopiëren als afbeelding en ook ergens plakken.

Maar om ze dan in een opmerking te krijgen zou je die afbeelding eerst moeten opslaan en dan ophalen.

Ben niet helemaal zeker of het toch niet mogelijk is om die gekopieërde afbeelding rechtstreeks in een opmerking te krijgen.

 

[HarryBee]

Cobbe,

Je brengt me op een idee. Ik ga even wat uitproberen. Als het lukt zal ik de complete code plaatsen.
Bedankt tot zover!

Groet Harry

 

[HarryBee]

Beste helpers. Allereerst mijn dank aan Cobbe en Sylvester-Ponte voor het meedenken voor een oplossing. Ik ben mede hierdoor op de volgende oplossing gekomen:

Sub ToevoegenComment()
Dim Target As Range
Dim Cancel As Boolean
Set Target = ActiveCell
With Target
        .AddComment
        .Comment.Visible = False
        .Comment.Shape.ScaleWidth 2.4, msoFalse, msoScaleFromTopLeft
        .Comment.Shape.ScaleHeight 2.8, msoFalse, msoScaleFromTopLeft
        .Comment.Text Text:=Range("J15").Value & Chr(10) & "" & [J16].Value & Chr(10) & "" & [J17].Value & Chr(10) & "" & [J18].Value & Chr(10) & ""
        'InputBox("Geef je commentaar", "Commentaar toevoegen")
        
    End With
End Sub

Door in de betreffende cellen een samenvoeging van tekst te maken, heb ik het doel bereikt.

Groeten Harry

Alvast fijne feestdagen.