Alternatieve tekst van afbeelding in een cel wegschrijven

[Rob7]

Op 3/1/2020 om 15:35, dotchiejack zei:

Dit kan wel degelijk, de positie bepalen.

Maar weet ik nu wat je wilt bereiken, neen dus, ik moet afhaken.

Volgende code geeft de positie van je eerste foto weer. (het verkeersbord)

Slepen maar.

Sub dotch()
Dim x
Dim y
Dim z
With ActiveSheet.Shapes(1)
  x = .Name
  y = .Top
  z = .Left
End With
MsgBox x & vbCr & "top is " & y & vbCr & "links is " & z
End Sub

 

Je opmerkingen in deze en zeker vorige posts hebben mij in elk geval een heel eind vooruit geholpen . Waarvoor dank .

[Rob7]

Op 3/1/2020 om 16:32, bakerman zei:

Sub TestShapes2()

Dim oShape As Shape, img1 As String, img2 As String

With ActiveSheet
   For Each oShape In .Shapes
        If oShape.TopLeftCell.Address = "$A$1" Then
            img1 = oShape.AlternativeText
        ElseIf oShape.TopLeftCell.Address = "$C$1" Then
            img2 = oShape.AlternativeText
        End If
   Next oShape
End With

If (img1 <> vbNullString) * (img2 <> vbNullString) Then
    MsgBox IIf(img1 = img2, "Gelijke", "Ongelijke") & " afbeeldingen"
End If

End Sub

Speel hier maar eens mee.

 

Test de code in het voorbeeldbestand, sleep daarna de afbeeldingen naar andere posities, wijzig de adressen in de code en draai de code opnieuw.

 

 

test vgl foto's.xlsm 249 kB · 6 downloads

Werkt inderdaad netjes . Bedankt .

Ik heb nog een ( hopelijk laatste ) vraag :

Ik vraag me af of wat ik tracht te bereiken niet nog sneller kan door niet twee foto's te vergelijken , maar wel de naam van de foto ( ik wist tot voor kort niet dat afbeeldingen een naam hadden ) te controleren . Ik dacht aan de volgende macro . Die geeft geen compileer- of run-time fouten , maar hij doet ook niet wat ik ( niet ) vraag .

 

Sub Nummers_afbeeldingen_controleren()

With ActiveSheet
   
   If [A1].Value = ("Afbeelding 18") Then
   .[B1].Value = 1
   End If
  
End With
End Sub

 

Er is nog iets mis met de ("Afbeelding 18") . Omdat het geen Value is ?

 

[bakerman]

With ActiveSheet
   For Each oShape In .Shapes
        If (oShape.TopLeftCell.Address = "$A$1") * (oShape.Name = "Afbeelding 18") Then
            MsgBox "Succes"
        End If
   Next oShape
End With

 

[Rob7]

20 uren geleden, bakerman zei:

With ActiveSheet
   For Each oShape In .Shapes
        If (oShape.TopLeftCell.Address = "$A$1") * (oShape.Name = "Afbeelding 18") Then
            MsgBox "Succes"
        End If
   Next oShape
End With

 

Ik heb uw instructies in bestandje gezet maar er gebeurt niet zo veel wanneer ik macro uitvoer . 

test vgl foto's (2).xlsm

[bakerman]

Sub Bakerman()
With ActiveSheet
   For Each oShape In .Shapes
        If (oShape.TopLeftCell.Address = "$A$1") * (oShape.Name = "Afbeelding 18") Then
            .Range("B1") = 1
        End If
   Next oShape
End With
End Sub

Nu komt er een 1 in B1 als aan de voorwaarden die jij gesteld hebt voldaan wordt. Als dit niet is wat je bedoelt dan begrijp ik je vraag helaas niet.

[emielDS]

de bedoeling is dat de alt.tekst van de foto, die in A1 staat, in cel G1 komt

[bakerman]

Op 6/1/2020 om 00:40, Rob7 zei:

Ik heb nog een ( hopelijk laatste ) vraag :

Ik vraag me af of wat ik tracht te bereiken niet nog sneller kan door niet twee foto's te vergelijken , maar wel de naam van de foto ( ik wist tot voor kort niet dat afbeeldingen een naam hadden ) te controleren . Ik dacht aan de volgende macro . Die geeft geen compileer- of run-time fouten , maar hij doet ook niet wat ik ( niet ) vraag .

 

Sub Nummers_afbeeldingen_controleren()

With ActiveSheet
   
   If [A1].Value = ("Afbeelding 18") Then
   .[B1].Value = 1
   End If
  
End With
End Sub

 

Er is nog iets mis met de ("Afbeelding 18") . Omdat het geen Value is ?

Het stadium van de Alternatieve tekst zijn we al voorbij Emiel, dit was al een antwoord op de volgende bovenstaande vraag.

[Rob7]

15 uren geleden, bakerman zei:

Sub Bakerman()
With ActiveSheet
   For Each oShape In .Shapes
        If (oShape.TopLeftCell.Address = "$A$1") * (oShape.Name = "Afbeelding 18") Then
            .Range("B1") = 1
        End If
   Next oShape
End With
End Sub

Nu komt er een 1 in B1 als aan de voorwaarden die jij gesteld hebt voldaan wordt. Als dit niet is wat je bedoelt dan begrijp ik je vraag helaas niet.

Er komt bij mij geen 1 in B1 . Er kwam in de vorige versie ook geen MsgBox met Succes . Dat was wat ik bedoelde toen ik zei " Ik heb uw instructies in bestandje gezet maar er gebeurt niet zo veel wanneer ik macro uitvoer . ".

Ik heb een ( oudere ) versie van Excel , 2010 . Is dat mogelijk de oorzaak van het verschil ?

[emielDS]

Om het nog iets ingewikkelder te maken.

test vgl foto's2 (1).xlsm

[bakerman]

Deze werkt perfect voor mij.

 

PS: Code staat nu in een Standaard module ipv in ThisWorkbook.

test vgl foto's ba.xlsm