Insertion et formatage automatique d'une photo en VBA

VBA
1

Bonjour,

Quelqu’un peut-il me dire ce qui ne va pas dans ce code?

Merci d’avance

Sub ajt_photo()
Dim DosPhoto As FileDialog
With Feuille6
Set DosPhoto = Application.FileDialog(msoFileDialogFolderPicker)
With DosPhoto
.Title = « séléctionner une photo »
.Filters.Add « A11 picture Files », « *.jpg,*jpeg,*gif,*png,bmp,.tiff », 1
If .Show <> -1 Then GoTo NoSelection
Feuille6.Range(« M10 »).Value = .SelectedItems(1)
End With
afficher_photo
NoSelection:
End With
End Sub

Sub afficher_photo()
Dim LienPhoto As String
With Feuille6
On Error Resume Next
.Shapes(« Photo_existante »).Delete
On Error GoTo 0
LienPhoto = .Range(« M10 »).Value
With .Pictures.Insert(LienPhoto)

With .ShapeRange
.LockAspectRatio = msoTrue
.Height = 140
.Name = « Photo_existante »
End With
End Sub

With .Shapes(« Photo_existante »)
.Left = Feuille6.Range(« K8 »).Left
.Top = Feuille6.Range(« K8 »).Top
.IncrementLeft 30

End With
End With

End Sub

2

Bonjour ,

Pas expert une chose m’a frappé, vous avez une étiquette ****NoSelection****: mais aucune instruction après cette étiquette

3

Merci pour la réponse.

Je ne suis pas expert non plus…

je vais attendre vois si d’autres réponses :grinning:

4

Bonjour Johnny
Je ne suis pas chez moi actuellement
Je suis en voyage à Vienne en Autriche
Je consulte le forum le soir
L’instruction :

NoSelection:

Fonctionne avec la ligne de code en amont :

If .Show <> -1 Then GoTo NoSelection

C’est à dire que si il n’y a aucune selection de réalisée dans cette partie :

Application.FileDialog(msoFileDialogFolderPicker)
With DosPhoto

Le traitement doit continuer son exécution à partir de cette balise :

NoSelection:

Il est donc normal que cette ligne soit ainsi ce n’est qu’une balise

Pour la demande de notre interlocuteur elle est un peu pauvre dans son exposé aucune indication sur l’anomalie rencontrée
Il serait bien qu’il détaille la difficulté qu’il rencontre
Moi actuellement impossible de tester le code

A mon retour si cela n’a pas progressé je pourrai m’y pencher mais je souhaiterais plus d’élément sur le blocage subit

A bientôt j’espère

5

Hello

Merci pour ton aide

Apparement le problème résiderais dans cette partie la du code:

.Filters.Add « A11 picture Files », « *.jpg,*jpeg,*gif,*png,bmp,.tiff », 1

6

Oui mais quelle est la manifestation du dysfonctionnement
bug avec quel message ?
Autre mais quoi ?
Merci d’être plus precis là où je suis je ne peux pas tester donc ne peux le concrétiser

7

Bonjour,
Il y a pas mal de ligne qui n’allait pas, voici une correction :

Sub ajt_photo()
Dim DosPhoto As FileDialog
With ActiveSheet 'activesheet au lieu de Feuille6
Set DosPhoto = Application.FileDialog(msoFileDialogFilePicker) 'FilePicker au lieu de FolderPicker
With DosPhoto
.Title = "séléctionner une photo"
.Filters.Add "A11 picture Files", "*.jpg,*jpeg,*gif,*png,bmp,.tiff", 1
If .Show <> -1 Then GoTo NoSelection
ActiveSheet.Range("M10").Value = .SelectedItems(1) 'activesheet au lieu de Feuille6
End With
afficher_photo
NoSelection:
End With
End Sub

Sub afficher_photo()
Dim LienPhoto As String
With ActiveSheet 'activesheet au lieu de Feuille6
On Error Resume Next
.Shapes("Photo_existante").Delete
On Error GoTo 0
LienPhoto = .Range("M10").Value
With .Pictures.Insert(LienPhoto)
With .ShapeRange
.LockAspectRatio = msoTrue
.Height = 140
.Name = "Photo_existante"
End With
End With ' remplacer par End With au lieu de End Sub
With .Shapes("Photo_existante")
    .Left = ActiveSheet.Range("K8").Left 'activesheet au lieu de Feuille6
    .Top = ActiveSheet.Range("K8").Top 'activesheet au lieu de Feuille6
    .IncrementLeft 30
End With
End With
End Sub

Bien cordialement

8

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.