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

Microsoft 365 Application.GetOpenFilename et multiSelect

Cédric06400

XLDnaute Junior
Bonjour,

j'ai créé un code pour importer une photo depuis un UF vers ma feuille active avec mise en forme.

Maintenant j'aimerai modifier ce code pour que pouvoir sélectionner plusieurs photos en meme temps.

Tout en gardant la section de toutes les photos pour une mise en forme glogale.

Sub Cmd_image()

On Error Resume Next
Photo = Application.GetOpenFilename("Fichiers jpg,*.jpg")
If Not Photo = False Then
Set monimage = ActiveSheet.Pictures.Insert(Photo)
End If
'
If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then
Formatphoto
Else
Formatphotosans
End If
On Error GoTo 0

End Sub

Pourriez vous m'aider ?

Merci
 
Solution
re
Bonjour @fanch55 oui tu a raison je sais pas pourquoi je l'ai enlevé dans le else
va savoir des fois je déraille
edit:
heu ..non ma reponse en post #12 est valide

VB: 
Sub Cmd_image()
    Dim photo As Variant, I&, OK As Boolean ' variables

    photo = Application.GetOpenFilename("Image JpG (*.jpg;*.jpeg), *.jpg;*.jpeg", 1, "CHOISIR DES IMAGES", , True)
    'ouverture du dialog

    If IsArray(photo) Then ' si multi selection

        'OK devient true ou false selon la reponse
        If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then OK = True

        For I = LBound(photo) To UBound(photo) 'boucle sur tout les item selectionnés dans le dialog

            Set monimage =...
Trier par date Trier par votes

patricktoulon

XLDnaute Barbatruc
Bonjour
photo doit être variant et on boucle sur ce variant
comme ceci : le code est commenté
VB: 
Sub Cmd_image()
    Dim photo As Variant, I& ' variables

    photo = Application.GetOpenFilename("Fichiers jpg,*.jpg") 'ouverture du dialog
   
    If photo = False Then Exit Sub ' si click sur annuler ou fermeture par croix

    If IsArray(photo) Then ' si multi selection
        For I = LBound(photo) To UBound(photo) 'boucle sur tout les item selectionnés dans le dialog

            Set monimage = ActiveSheet.Pictures.Insert(photo(I)) 'insertion de la photo
           
            ' à chaque  nouvelle photo question et traitement en fonction de la réponse
            If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then
                Formatphoto 'appel de la sub pour formater
            Else
                Formatphotosans 'appel de la sub sans formatage
            End If
       
        Next

    Else 'sinon si il y a qu'une photo

        Set monimage = ActiveSheet.Pictures.Insert(photo) 'insertion photo
       
        'question et traitement en fonction de la réponse pour la seul photo selectionnée
        If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then
            Formatphoto 'appel de la sub pour formater
        Else
            Formatphotosans 'appel de la sub sans formatage
        End If
 
    End If

End Sub

on pourrait simplifier en ne demandant qu'une seule fois la question de mise en forme
sauf si c'est pour le cas ou les photo serait retourné là par contre on laisse comme ça car c'est au cas par cas
bonne route
patrick
 
Vote positif 0 Vote négatif

Cédric06400

XLDnaute Junior
Hello merci,

je testerais ta solution ce soir.

J'avais une solution avec une boucle, mais ça lagué. Je vais tester

Bien à toi
 
Vote positif 0 Vote négatif

Cédric06400

XLDnaute Junior
Hello,
Je viens de tester ta solution
Lors de l'ouverture de la boite de dialogue je ne peux sélectionner qu'une seule photo
Merci de ton retour

Cédric
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re
Bonjour
oui mille excuses j'ai fait la moitié du travail
VB: 
Sub Cmd_image()
    Dim photo As Variant, I& ' variables

    photo = Application.GetOpenFilename("Image JpG (*.jpg;*.jpeg), *.jpg;*.jpeg", 1, "CHOISIR DES IMAGES", , True)
    'ouverture du dialog

    If IsArray(photo) Then ' si multi selection
        For I = LBound(photo) To UBound(photo) 'boucle sur tout les item selectionnés dans le dialog

            Set monimage = ActiveSheet.Pictures.Insert(photo(I)) 'insertion de la photo

            ' à chaque  nouvelle photo question et traitement en fonction de la réponse
            If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then
                Formatphoto 'appel de la sub pour formater
            Else
                Formatphotosans 'appel de la sub sans formatage
            End If

        Next

    Else 'sinon si il y a qu'une photo

        If photo = False Then Exit Sub ' si click sur annuler ou fermeture par croix

        Set monimage = ActiveSheet.Pictures.Insert(photo) 'insertion photo

        'question et traitement en fonction de la réponse pour la seul photo selectionnée
        If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then
            Formatphoto 'appel de la sub pour formater
        Else
            Formatphotosans 'appel de la sub sans formatage
        End If

    End If

End Sub
 
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Bonjour Cédric06400, Patrick,

Au lieu de Application.GetOpenFilename utilisez Application.FileDialog(msoFileDialogFilePicker)

Avec .AllowMultiSelect = True

Qu'il y ait un ou plusieurs fichiers sélectionnés l'utilisation est la même avec .SelectedItems.

A+
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
re
Bonjour @job75
oui encodé dans un bloc with pour le test show -1 sinon c'est le boom quand on annule
return à prendre en considération
  1. un
  2. plusieurs
  3. annuler
getopenfilename lui renvoie
  1. un variant string pour un
  2. un variant() array pour plusieurs
  3. false si annuler
et cela sans avoir besoins de tester le .show bien évidemment puisque c'est une fonction externe ouvrant un dialog et renvoyant ce qui est fait dans le dialog
 
Vote positif 0 Vote négatif

Cédric06400

XLDnaute Junior
Hello,
Merci beaucoup pour le code qui fonctionne parfaitement.
J'ai cependant une amélioration à te demander.
Avec ce code tu boucles sur chaque photo pour demander le type de Mise en forme, ce qui peut être fastidieux si tu as beaucoup de photos.
Ce que j'applique manuellement depuis des années c'est de réaliser la mise en forme sur l'ensemble de la sélection, ce qui permet de répondre une seule fois à la question.
Je sais que j'abuse, j'ai fait beaucoup de progrès grâce à vous tous, malheureusement je suis encore très limité.
Si tu as encore quelques minutes ...
Merci infiniment
Cédric
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
Bonjour @Cédric06400
c'est justement la proposition que je t'ai faite en post#2
je cite
on pourrait simplifier en ne demandant qu'une seule fois la question de mise en forme
sauf si c'est pour le cas ou les photo serait retourné là par contre on laisse comme ça car c'est au cas par cas
Cliquez pour agrandir...
donc voila la simplification pour la selection multiple dans le dialog
VB: 
Sub Cmd_image()
    Dim photo As Variant, I&, OK As Boolean ' variables

    photo = Application.GetOpenFilename("Image JpG (*.jpg;*.jpeg), *.jpg;*.jpeg", 1, "CHOISIR DES IMAGES", , True)
    'ouverture du dialog

    If IsArray(photo) Then ' si multi selection

        'OK devient true ou false selon la reponse
        If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then OK = True

        For I = LBound(photo) To UBound(photo) 'boucle sur tout les item selectionnés dans le dialog

            Set monimage = ActiveSheet.Pictures.Insert(photo(I)) 'insertion de la photo

            If OK Then 'si OK est true on formate
                ' à chaque  nouvelle photo question et traitement en fonction de la réponse
                Formatphoto 'appel de la sub pour formater
            Else 'sinon on formate pas
                Formatphotosans 'appel de la sub sans formatage
            End If

        Next

    Else 'sinon si il y a qu'une photo

        If photo = False Then Exit Sub ' si click sur annuler ou fermeture par croix

        Set monimage = ActiveSheet.Pictures.Insert(photo) 'insertion photo

        ' dans la partie un seul fichier selectionné on change pas le code
        'question et traitement en fonction de la réponse pour la seul photo selectionnée
        If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then
            Formatphoto 'appel de la sub pour formater
        Else
            Formatphotosans 'appel de la sub sans formatage
        End If

    End If

End Sub
voili voilou
si ton problème est résolu pointe le comme solution sur la réponse qui te convient le plus
 
Vote positif 0 Vote négatif

Cédric06400

XLDnaute Junior
Hello,

Pardon mais j'ai 2 soucis :

Le 1ere est que la boucle sur la mise en forme de chaque photo est toujours présente, alors qu'on souhaite formater l'ensemble de la sélection sur une seule réponse.


Ensuite une fois la (les) photo(s) insérée(s) la macro ne garde pas la sélection aussi les macros de mise en forme s'arrêtent.

Sub Formatphoto()
'
Selection.ShapeRange.Height = 113.3858267717
Selection.ShapeRange.IncrementRotation 90
Selection.ShapeRange.ZOrder msoSendToBack
End Sub

Sub Formatphotosans()
'
Selection.ShapeRange.Height = 113.3858267717
Selection.ShapeRange.ZOrder msoSendToBack
End Sub

On y est presque encore merci pour ton aide

Cédric
 
Vote positif 0 Vote négatif

Cédric06400

XLDnaute Junior
Hello je me permet de revenir vers toi,


Pardon mais j'ai 2 soucis :

Le 1ere est que la boucle sur la mise en forme de chaque photo est toujours présente, alors qu'on souhaite formater l'ensemble de la sélection sur une seule réponse.



Ensuite une fois la (les) photo(s) insérée(s) la macro ne garde pas la sélection aussi les macros de mise en forme s'arrêtent.

Sub Formatphoto()
'
Selection.ShapeRange.Height = 113.3858267717
Selection.ShapeRange.IncrementRotation 90
Selection.ShapeRange.ZOrder msoSendToBack
End Sub

Sub Formatphotosans()
'
Selection.ShapeRange.Height = 113.3858267717
Selection.ShapeRange.ZOrder msoSendToBack
End Sub

On y est presque encore merci pour ton aide

Cédric
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
bonjour
et bien on select pas on cible
VB: 
Sub Cmd_image()
    Dim photo As Variant, I&, OK As Boolean ' variables

    photo = Application.GetOpenFilename("Image JpG (*.jpg;*.jpeg), *.jpg;*.jpeg", 1, "CHOISIR DES IMAGES", , True)
    'ouverture du dialog

    If IsArray(photo) Then ' si multi selection

        'OK devient true ou false selon la reponse
        If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then OK = True

        For I = LBound(photo) To UBound(photo) 'boucle sur tout les item selectionnés dans le dialog

            Set monimage = ActiveSheet.Pictures.Insert(photo(I)) 'insertion de la photo

            If OK Then 'si OK est true on formate
                ' à chaque  nouvelle photo question et traitement en fonction de la réponse
                Formatphoto monimage 'appel de la sub pour formater
            Else 'sinon on formate pas
                Formatphotosans monimage 'appel de la sub sans formatage
            End If

        Next

    Else 'sinon si il y a qu'une photo

        If photo = False Then Exit Sub ' si click sur annuler ou fermeture par croix

        Set monimage = ActiveSheet.Pictures.Insert(photo) 'insertion photo

        ' dans la partie un seul fichier selectionné on change pas le code
        'question et traitement en fonction de la réponse pour la seul photo selectionnée
        If MsgBox("Mise en forme avec rotation ?", vbYesNoCancel, "Mise en forme photo") = vbYes Then
            Formatphoto monimage 'appel de la sub pour formater
        Else
            Formatphotosans monimage 'appel de la sub sans formatage
        End If

    End If

End Sub

Sub Formatphoto(img)
    With ActiveSheet.Shapes(img.Name)
        .Height = 113.3858267717
        .IncrementRotation 90
        .ZOrder msoSendToBack
    End With
End Sub

Sub Formatphotosans(img)
    With ActiveSheet.Shapes(img.Name)
        .Height = 113.3858267717
        .ZOrder msoSendToBack
    End With
End Sub
 
Vote positif 0 Vote négatif

patricktoulon

XLDnaute Barbatruc
Le 1ere est que la boucle sur la mise en forme de chaque photo est toujours présente, alors qu'on souhaite formater l'ensemble de la sélection sur une seule réponse.
Cliquez pour agrandir...
j'avoue que je pige pas ta question la
qu'est ce qu'on en a a foutre de les faire toute en même temps ou l'une après l'autre lors de insertion ?
 
Vote positif 0 Vote négatif

Cédric06400

XLDnaute Junior
patricktoulon à dit:
j'avoue que je pige pas ta question la
qu'est ce qu'on en a a foutre de les faire toute en même temps ou l'une après l'autre lors de insertion ?
Cliquez pour agrandir...
Hello,
Il n'est pas rare que j'importe 50 photos en même temps, donc répondre 50 fois à la même question est inutile.
Ce qui rend l'opération inutile dans mon cas.
Ce programme vise à intégrer la fonction "insérer un ou des image" dans un userform qui me permet de trier, déplacer et placer correctement les photos dans chaque rapport.

Voila maintenant tu sais tout.
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

P
  • Question
Microsoft 365 VBA insert photos
Réponses
12
Affichages
744
PHV62
P
  • Question
XL 2021 Orientation d'une image dans le commentaire d'une cellule
2 3
Réponses
42
Affichages
2 K
AtTheOne
T
  • Résolu(e)
Microsoft 365 Insérer une image DANS une cellule
Réponses
12
Affichages
666
Thomi
T
F
  • Question
Microsoft 365 Changement de fonctionnement d'une macro suite au passage à windows 10
Réponses
1
Affichages
452
francha62
F
S
  • Question
Microsoft 365 Enregistrer les images dans un dossier
Réponses
2
Affichages
264
Simon 1234
S
M
  • Question
XL 2010 Remise et ajout de quantité
Réponses
10
Affichages
679
Dranreb
  • Résolu(e)
XL 2010 Userform plein écran sans barre de titre
Réponses
7
Affichages
424
cathodique
L
  • Question
Microsoft 365 Macro Insertion image dans cellule
Réponses
3
Affichages
784
Dranreb
C
  • Question
XL 2021 Dernière ligne d'un fichier fermé
Réponses
7
Affichages
518
Chris 33
C
D
  • Question
envois automatique d'email avec EXCEL et une MACRO
Réponses
4
Affichages
888
AtTheOne
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…