Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

Webperegrino

XLDnaute Impliqué
Supporter XLD
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
 
Dernière édition:

fanch55

XLDnaute Barbatruc
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 .


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

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

( tous les paramètres sont obligatoires)
 

Webperegrino

XLDnaute Impliqué
Supporter XLD
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

XLDnaute Barbatruc
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
 

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…