XL 2016 Supprimer une image.JPG puis Intégrer une nouvelle.JPG au-dessus du groupe de cellules A13:A14

Webperegrino · 15 Mai 2023

Bonjour les Amis du Forum,

J’ai une Erreur d’exécution ‘1004’ (Erreur définie par l’application ou par l’objet) sur la ligne suivante.
La macro qui me permet de supprimer une image. JPG sur le groupe A13:A14 d'une feuille.
Pouvez-vous m’indiquer ce qui est mal écrit ?

L'idéal serait aussi que cette macro "ne bugue pas" s'il n'y a pas d'image.jpg sur ces deux cellules...

'Objectif de la macro : S'il y a une ou des images.jpg au-dessus de la cellule A13 alors supprimez-la ...
'mais on conservera les boutons ailleurs sur cette feuille (contrôle, Active X...)

VB:

Dim s As Shape
For Each s In ActiveSheet.Shapes
[B]  If Not Intersect(s.TopLeftCell, Range("A13:A14")) Is Nothing Then 'c'est sur cette ligne que j'ai "ERREUR 1004"[/I][/COLOR]
  s.Delete
  End If
Next

D'autre part, dans une deuxième macro d’intégration d’une image.JPG sur ces cellules A13:A14 j’ai l’expression suivante :

VB:

PlaceThePictureInCenterRange Range("A13:A14"), Shapes.AddPicture(File, False, True, 20, 20, -1, -1), 90

Voici ce que j'ai dans cette 2ème macro :

VB:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("N10")) Is Nothing Then
Cancel = True: UserForm1.Show 'la liste des prénoms
'insertion trombi
'ma macro de suppression des image.JPG sur A13:A14 ?
[W10] = 0
Application.ScreenUpdating = False
'place les photos du TROMBINOSCOPE
Dim File As Variant, Fso As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
For Each File In Fso.GetFolder([PhotoDir]).Files
  If File.Name Like "*.jpg" Then
    [W10] = [W10] + 1
    ' N10 est le prénom de la personne, Q10 est le Nom de la personne dont je cherche sa Photo.JPG placée dans un dossier voisin de fichier excel
    If Application.WorksheetFunction.Proper(Range("N10")) & " " & Range("Q10") = Fso.getBasename(File) Then
      PlaceThePictureInCenterRange Range("A13:A14"), Shapes.AddPicture(File, False, True, 20, 20, -1, -1), 90
    End If
  End If
Next
Set Fso = Nothing ' Mémoire lib.
Application.ScreenUpdating = True
End If
End Sub

Pouvez-vous me donner un peu de pédagogie pour ce qui de l’emploi des différents nombres inclus dans cette expression ?
J'ai du mal à l'interpréter et ne sais pas pourquoi cette suite est nécessaire

Merci,
Webperegrino

fanch55 · 15 Mai 2023

Bonjour,
Le code donné ne peut pas planter

Enrichi (BBcode):

Dim s As Shape
For Each s In ActiveSheet.Shapes
  If Not Intersect(s.TopLeftCell, Range("A13:A14")) Is Nothing Then 'c'est sur cette ligne que j'ai "ERREUR 1004"
  s.Delete
  End If
Next

Donnez un classeur exemple .

Webperegrino à dit:
VB:
PlaceThePictureInCenterRange Range("A13:A14"), Shapes.AddPicture(File, False, True, 20, 20, -1, -1), 90

Webperegrino à dit:
Pouvez-vous me donner un peu de pédagogie pour ce qui de l’emploi des différents nombres inclus dans cette expression ?
J'ai du mal à l'interpréter et ne sais pas pourquoi cette suite est nécessaire

Méthode Shapes.AddPicture (Excel)

Rubrique de référence sur Office VBA

learn.microsoft.com

( tous les paramètres sont obligatoires)

Webperegrino · 15 Mai 2023

Le Forum,
Bonjour Fanch55,
Merci pour votre intervention rapide.
Extraire une partie de "mon usine à gaz dans laquelle figure cette macro" et créer un Trombinoscope fictif m'aurait pris trop de temps.

Je viens de trouver (et appliquer) une parade (de sortie d'exécution de la macro au moment du message d'erreur).
Cela me satisfait pour l'instant car ça fonctionne ! (le message d'erreur est caché, la macro exécute parfaitement ce que je veux obtenir).
Voici ce que j'ai ajouté (ci-après).
Quant à votre lien pour comprendre l'expression n° 2 avec codes et nombres, merci pour l'envoi, je vais étudier cela tranquillement.
Cordialement,
Webperegrino

VB:

Private Sub CommandButton2_Click() 'suppr Shapes
Dim s As Shape
Application.DisplayAlerts = False
For Each s In ActiveSheet.Shapes
  If Not Intersect(s.TopLeftCell, Range("A13:A14")) Is Nothing Then
  s.Delete
  On Error GoTo Fin
  End If
Fin:
Application.DisplayAlerts = True
Next
End Sub

fanch55 · 15 Mai 2023

Webperegrino à dit:
Je viens de trouver (et appliquer) une parade (de sortie d'exécution de la macro au moment du message d'erreur).
Cela me satisfait pour l'instant car ça fonctionne ! (le message d'erreur est caché, la macro exécute parfaitement ce que je veux obtenir).

VB:

Private Sub CommandButton2_Click() 'suppr Shapes Dim s As Shape Application.DisplayAlerts = False For Each s In ActiveSheet.Shapes If Not Intersect(s.TopLeftCell, Range("A13:A14")) Is Nothing Then s.Delete On Error GoTo Fin End If Fin: Application.DisplayAlerts = True Next End Sub

Surprenant: le DisplayAlerts ne cache pas une erreur ni ne l'évite.
J'aurai plutôt fait un code comme ci-dessous ( bien que je persiste à croire qu'il ne peut y avoir d'erreur ) :

VB:

Private Sub CommandButton2_Click() 'suppr Shapes
Dim s As Shape
    On Error Resume Next
    For Each s In ActiveSheet.Shapes
      If Not Intersect(s.TopLeftCell, Range("A13:A14")) Is Nothing Then s.Delete
    Next
End Sub

Webperegrino · 15 Mai 2023

Le Forum,
Fanch55,
Vous avez raison : vos codes sont plus réduits et fonctionnent parfaitement.
Je les adopte définitivement, merci encore pour votre aide.
Cordialement,
Webperegrino

XL 2016 Supprimer une image.JPG puis Intégrer une nouvelle.JPG au-dessus du groupe de cellules A13:A14

Webperegrino

XLDnaute Impliqué

fanch55

XLDnaute Barbatruc

Méthode Shapes.AddPicture (Excel)

Webperegrino

XLDnaute Impliqué

fanch55

XLDnaute Barbatruc

Webperegrino

XLDnaute Impliqué

Discussions similaires