Opgelost Opmerking toevoegen aan cel via formule

[frans kooijman]

Hi,
Weet iemand of het mogelijk is om via een formule een standard opmerking toe te voegen aan een cel?
Zie bijlage: Als kolom B > 15 is èn kolom A = Marie, dan in die cel(len) een standaard opmerking toevoegen.

Kan zoiets?
Frans

 

[HSV]

Dat kan, maar als je het getal weer <15 maakt verdwijnt de opmerking niet met onderstaande code (die zal aangepast moeten worden).

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 2 And Target.Value > 15 And LCase(Target.Offset(, -1)) = "marie" Then Target.AddComment "aantal is correct"
End Sub

 

[frans kooijman]

Ah, duidelijk, dank !!

 

[mvdvlist]

Wat denk je van zowel tekst of foto's toevoegen?

Sub VoegFotoToeAanAlleSKU()
    Dim sku As String
    Dim fotoPad As String
    Dim ws As Worksheet
    Dim cel As Range
    Dim shp As Shape
    Dim note As Comment

    ' Vraag SKU
    sku = InputBox("Welk SKU-nummer wil je koppelen aan een foto?", "SKU foto")
    If Trim(sku) = "" Then Exit Sub

    ' Vraag foto
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Selecteer een foto voor SKU " & sku
        .Filters.Add "Foto", "*.jpg; *.jpeg; *.png"
        .AllowMultiSelect = False

        If .Show <> -1 Then Exit Sub
        fotoPad = .SelectedItems(1)
    End With

    ' Tijdelijke shape voor afmetingen
    Set shp = ActiveSheet.Shapes.AddPicture(fotoPad, msoFalse, msoTrue, 0, 0, -1, -1)
    shp.LockAspectRatio = msoTrue
    shp.Height = 200

    ' Door alle sheets heen
    For Each ws In ThisWorkbook.Worksheets

        ' Door alle gebruikte cellen heen
        For Each cel In ws.UsedRange
            If Trim(cel.Value) = sku Then

                ' Oude commentaar weg
                If Not cel.Comment Is Nothing Then cel.Comment.Delete

                ' Nieuwe commentaar
                Set note = cel.AddComment
                note.Text ""

                With note.Shape
                    .Fill.UserPicture fotoPad
                    .Height = 200
                    .Width = shp.Width / shp.Height * 200
                    .Line.Visible = msoFalse
                End With

            End If
        Next cel
    Next ws

    shp.Delete

    MsgBox "Foto gekoppeld aan alle cellen met SKU " & sku, vbInformation
End Sub
 
 Sub KoppelFotosAanSKU()
    Dim ws As Worksheet
    Dim cel As Range
    Dim fotoPad As String
    Dim shp As Shape
    Dim note As Comment

    Set ws = Worksheets("DATABASE")

    For Each cel In ws.UsedRange
        If Trim(cel.Value) <> "" Then

            fotoPad = ThisWorkbook.Path & "\Afbeeldingen\" & Trim(cel.Value) & ".jpg"

            If Dir(fotoPad) <> "" Then

                Set shp = ws.Shapes.AddPicture(fotoPad, msoFalse, msoTrue, 0, 0, -1, -1)
                shp.LockAspectRatio = msoTrue
                shp.Height = 200

                If Not cel.Comment Is Nothing Then cel.Comment.Delete

                Set note = cel.AddComment
                note.Text ""

                With note.Shape
                    .Fill.UserPicture fotoPad
                    .Height = 200
                    .Width = shp.Width / shp.Height * 200
                    .Line.Visible = msoFalse
                End With

                shp.Delete
            End If
        End If
    Next cel

    MsgBox "Foto's gekoppeld waar mogelijk."
End Sub


Sub VerwijderFotoOpmerkingenUitSelectie()
    Dim cel As Range

    For Each cel In Selection
        If Not cel.Comment Is Nothing Then
            cel.Comment.Delete
        End If
    Next cel
End Sub

 

[peter59]

Van welke bron is de code afkomstig?