in comment plaatje plaatsen

[popipipo]

In een bestand wil ik tekst en plaatjes plaatsen in het "comment veld"
Ik weet hoe het handmatig moet maar ik heb 52 van deze velden met verschillend commentaar en verschillende plaatjes.
Het is slechts eenmalige handeling, maar wel arbeidsintensief

Het commentaar staat op een 2e tabblad en de plaatjes staan op de harddisk
Om het eenvoudig te houden heb ik de jpg plaatjes de naam van de week mee gegeven.
Kan dit geautomatiseerd worden of moet ik dit handmatig doen.

 

[Elmo839]

Hallo,

Begrijpt u Visual Basic?

Dan is dit een optie:http://answers.microsoft.com/en-us/office/forum/office_2007-excel/inserting-images-automatically-into-excel-2007/f460c5e0-2cab-4b8f-b8f6-006f6fb60ffd

Groeten,

Elmo839

 

[Cobbe]

Hier kan je wellicht alles halen dat je nodig zou kunnen hebben ivm je comments:

http://www.contextures.com/xlcomments03.html#Formatted

 

[edmoor]

Een voorbeeld voor het plaatsen van een opmerking en een plaatje in een cel via VBA:

Sub PlaatjeInOpmerking()
    With Worksheets("Blad1").Range("A1").AddComment
        .Text "Je opmerking tekst"
        With .Shape
            .Fill.UserPicture "C:\Plaatjes\Plaatje.png"
        End With
    End With
End Sub

 

[HSV]

Hier moet het mee lukken Willem.

Zorg dat er een spatie tussen week en de nummer komt net als op blad 1 links van de gele cellen.

Sub InvoegenFotoInOpmerking()
Dim Foto As String, c As Range
If Not Intersect(ActiveCell, Range("G3,J3,M3,P3,S3,V3,Y3,AB3,AE3,AH3")) Is Nothing Then
 ChDir "D:\Mijn Afbeeldingen\Harry"
    Foto = Application.GetOpenFilename(FileFilter:="Fotos (*.jpg), *.jpg", Title:="Kies een foto")
     If Foto <> "" Then
      ActiveCell.ClearComments
        With ActiveCell.AddComment
         .Text Sheets("Sheet2").Columns(1).Find("week 0" & ActiveCell.Offset(, -1), , xlValues, xlWhole).Offset(, 1).Text
ActiveCell.Comment.Shape.TextFrame.Characters.Font.ColorIndex = 4
       With .Shape
            .Height = .Height * 1.5
            .Width = .Width * 1.5
            .Fill.UserPicture Foto
         End With
      End With
    End If
End If
End Sub

 

[popipipo]

http://www.contextures.com/xlcomments03.html#Picture
Hier heb ik wat gevonden wat het bijna doet.

3 dingen gaan nog niet goed:
Hij voegt de tekst nog niet toe.
Hij voegt ook een (leeg) comment in de niet gekleurde vakken.
De grootte van het comment vlak past zich niet aan aan het formaat van het plaatje.

 

[HSV]

Hebben onze posts elkaar gekruist Willem?

 

[popipipo]

Ze hebben elk inderdaad gekruist.

Ik moet elk plaatje apart selecteren maar de tekst staat er wel meteen in en je hebt geen onnodige comments.
MAW Ik had in gedachte dat alles in een keer kon.
Maar omdat het een eenmalige actie is kan ik er goed mee leven.
Bedankt voor je oplossing.

 

[HSV]

Het is waarschijnlijk niet veel werk geweest om de tien plaatjes toe te voegen.
Hier zet ik toch maar de code om het in één keer te doen, mocht je er nog mee bezig gaan.

Sub InvoegenFotoInOpmerking()
Dim afb_map, Foto As String, j As Long
 For j = 7 To 34 Step 3
 afb_map = "D:\Popipipo\"
 Foto = afb_map & "Week " & Format(Cells(3, j - 1), "00") & ".jpg"
     If Foto <> "" Then
      Cells(3, j).ClearComments
        With Cells(3, j).AddComment
         .Text Sheets("Sheet2").Columns(1).Find("Week " & Format(Cells(3, j - 1), "00"), , xlValues, xlWhole).Offset(, 1).Text
Cells(3, j).Comment.Shape.TextFrame.Characters.Font.ColorIndex = 4
       With .Shape
            .Height = .Height * 1.5
            .Width = .Width * 1.5
            .Fill.UserPicture Foto
         End With
      End With
    End If
Next j
End Sub

 

[snb]

of:

Sub M_snb()
    On Error Resume Next
    
    For Each c In Range("g2:m2").SpecialCells(2)
        c.Offset(1).AddComment
        With c.Offset(1).Comment
          .Text c.Offset(-1).Value
          .Shape.Fill.UserPicture "G:\OF\" & c.Value
        End With
    Next
End Sub

 

[popipipo]

Met behulp van de oplossing in #5 gegeven heb ik het intussen al opgelost.
Toch nog bedankt voor de later gegeven oplossingen.