Microsoft 365 Application.GetOpenFilename et multiSelect

[Cédric06400]

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

 

[patricktoulon]

Bonjour
moi je pige pas pourquoi tu a la question 50 fois alors que la question est en dehors de la boucle dans le dernier exemple que je t'ai donné

il faudra m'expliquer

 

[Cédric06400]

Bonjour
moi je pige pas pourquoi tu a la question 50 fois alors que la question est en dehors de la boucle dans le dernier exemple que je t'ai donné
Regarde la pièce jointe 1206669
il faudra m'expliquer

Hello merci de ton retour, désolé j'ai que quelques minutes le matin pour coder avant de partir travailler.
Je vais m'y pencher ce week-end, je reviens vers toi

 

[fanch55]

Salut @patricktoulon ,
Tu as omis le traitement du cas de l' "annuler" ( petit oubli surement car tu l'as bien cité plus haut ).
Le code ci-dessous raccourcit ta proposition en intégrant l'annuler :

Sub Cmd_image()
    Dim photo As Variant, photos As Variant, OK As Boolean  ' variables

   'ouverture du dialog
    photos = Application.GetOpenFilename("Image JpG (*.jpg;*.jpeg), *.jpg;*.jpeg", 1, "CHOISIR DES IMAGES", , True)
    
    If VarType(photos) = vbBoolean Then
       ' = faux par spécificité
        MsgBox "stop": Exit Sub
    Else
        'OK devient true ou false selon la reponse
        OK = MsgBox("Mise en forme avec rotation ?", vbYesNo, "Mise en forme photo") = vbYes
        For Each photo In photos
            Set monimage = ActiveSheet.Pictures.Insert(photo) 'insertion de la photo
            If OK Then 'si OK est true on formate
                formatphoto 'appel de la sub pour formater
            Else 'sinon on formate pas
                formatphotosans 'appel de la sub sans formatage
            End If
        Next
    End If
End Sub

 

[patricktoulon]

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

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

 

[fanch55]

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



Else 'sinon si il y a qu'une photo

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

Exact, je n'avais pas franchi le else ...

 

[patricktoulon]

re
faute partagée car c'est mon commentaire qui n'est plus approprié sur la ligne "Else"

ca devrait être
'sinon si il n'y a pas un array d'images
car dans ce Else on gère une photo ou l'annulation

 

[Cédric06400]

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

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

Merciii