Stockage adresse image

Bonjour,

je n'ai pas réussi à trouver mon bonheur malgré quelques recherches.

Merci d'avance si vous pouvez m'aider sur le problème suivant : je souhaiterais créer un bouton commande qui ouvre une inputBox pour renseigner un chiffre puis après clic sur "OK" celui ouvre le répertoire par défaut et jusque là j'y parviens

Public Sub ajout_photo()

Dim dervaleur_a As Integer
dervaleur_a = Range("a65000").End(xlUp).Rows

Do
num_article = InputBox("Indiquer le numéro de l'article", "Quel article?")
If num_article = "" Then
        Exit Sub
Else
    Application.Dialogs(xlDialogOpen).Show
End If
Exit Sub
Loop While num_article = "" Or num_article > dervaleur_a

End Sub

L'idée est ensuite d'aller chercher une image sur le serveur. Je ne veux pas que l'image s'ouvre mais que son adresse soit stockée dans une cellule que je définis (ça sera la 1ere cellule vide en colonne B

Mais comment on fait ça ??

Merci beaucoup.

Oliv

bonjour,

voici une manière de faire.

Public Sub ajout_photo()

    Dim dervaleur_a As Integer
    dervaleur_a = Range("a65000").End(xlUp).Row

    Do
        num_article = InputBox("Indiquer le numéro de l'article", "Quel article?")
        If num_article = "" Then
            Exit Sub
        Else
            With Application.FileDialog(msoFileDialogOpen) 'choisir un fichier
                .AllowMultiSelect = False
                If .Show = -1 Then
                    dervaleur_a = dervaleur_a + 1 ' la premiere ligne libre
                    Cells(dervaleur_a, 2) = .SelectedItems(1) 'on copie le nom du fichier
                End If
            End With
        End If
        Exit Sub
    Loop While num_article = "" Or num_article > dervaleur_a

End Sub

je n'ai pas compris ce que tu voulais faire avec num_article ou ce à quoi il devait servir .

Merci pour ta réponse. Je vais tester.

"num_article" permet de renseigner un numéro d'article qui vient alimenter la colonne A (d'où dervaleur_a).

Pour le chemin de l'image il faut donc un dervaleur_b.

L'objectif finale est de dire, "je souhaite affecter tel image à tel article". Je renseigne donc mon article puis l'image qui va avec.

Oliv

re-bonjour,

je te propose dès lors le code suivant :

Public Sub ajout_photo()
    Dim dervaleur_a As Integer
    dervaleur_a = Range("a65000").End(xlUp).Row
    Do
        num_article = InputBox("Indiquer le numéro de l'article", "Quel article?")
        If num_article = "" Then
            Exit Sub 'on sort de la boucle si num_article=""
        Else
            With Application.FileDialog(msoFileDialogOpen) 'choisir un fichier
                .AllowMultiSelect = False
                If .Show = -1 Then
                    dervaleur_a = dervaleur_a + 1 ' la premiere ligne libre
                    Cells(dervaleur_a, 1) = num_article 'on copie le numéro d'article
                    Cells(dervaleur_a, 2) = .SelectedItems(1) 'on copie le nom du fichier
                End If
            End With
        End If
    Loop
End Sub

Alors, on est pas loin. adapté à mon fichier le code ressemble à cela :

Public Sub ajout_photo()

Dim dervaleur_a As Integer
dervaleur_a = Range("a65000").End(xlUp).Rows

Do
num_article = InputBox("Indiquer le numéro de l'article", "Quel article?")
If num_article = "" Then
        Exit Sub
Else
    With Application.FileDialog(msoFileDialogOpen) 'choisir un fichier
               .AllowMultiSelect = False
                If .Show = -1 Then
                    dervaleur_a = dervaleur_a - 1 ' la premiere ligne libre
                   Sheets("photo_doc").Cells(dervaleur_a, 1) = num_article
                   Sheets("photo_doc").Cells(dervaleur_a, 2) = .SelectedItems(1) 'on copie le nom du fichier
               End If

    End With

End If
Exit Sub

Loop While num_article = "" Or num_article > dervaleur

End Sub

Cela colle bien le numéro d'article ainsi que le chemin de l'image mais 2 lignes en dessous de la dernière vide... et je comprends pas trop pourquoi.

Par ailleurs je ne comprends pas ces lignes de code :

.AllowMultiSelect = False
                If .Show = -1 Then
                    dervaleur_a = dervaleur_a - 1 ' la premiere ligne libre

pourquoi - 1 ?

Merci encore à toi.

Oliv

Au temps pour moi, le "-1" c'est moi qui l'ai ajouté justement pour arriver à la 1ère cellule vide. Désolé.

C'est donc le "+1" je ne comprends pas

rebonjour,

cette instruction

dervaleur_a = Range("a65000").End(xlUp).Row

remarque qu'il n'y a pas de s à la fin de row, te donne le numéro de la dernière ligne utilisée dans la colonne A. la première ligne libre est donc la suivante d'où le +1.

Oui effectivement je n'avais pas remarqué. Merci de cette explication.

Cela ne résolve pas mon souci par contre, ce n'est pas la 1ère ligne vide qui se rempli...

De plus si je fais plusieurs fois la manip, cela remplace le copier-coller précédent alors que je souhaiterais que cela se mette sur la ligne suivante.

Merci quand même

Du coup, une autre manière : comment puis-je faire pour déplacer le fichier sélectionné dans un répertoire choisi ?

Oliv

re-bonjour,

voici la macro telle qu'il faut l'adapter pour ton fichier.

Public Sub ajout_photo()
    Dim dervaleur_a As Integer
    Set ws = Sheets("photo_doc")
    dervaleur_a = ws.Range("a65000").End(xlUp).Row
    Do
        num_article = InputBox("Indiquer le numéro de l'article", "Quel article?")
        If num_article = "" Then
            Exit Sub    'on sort de la boucle si num_article=""
        Else
            With Application.FileDialog(msoFileDialogOpen)    'choisir un fichier
                .AllowMultiSelect = False
                If .Show = -1 Then
                    dervaleur_a = dervaleur_a + 1    ' la premiere ligne libre
                    ws.Cells(dervaleur_a, 1) = num_article    'on copie le numéro d'article
                    ws.Cells(dervaleur_a, 2) = .SelectedItems(1)    'on copie le nom du fichier
                End If
            End With
        End If
    Loop
End Sub

Bravo ça fonctionne. Je te remercie beaucoup.

Donc juste pour finir, si je voulais en fin de boucle simplement copier cette image sélectionnée vers un répertoire que je défini, je fais comment ?

Merci.

oliv

bonsoir,

avec la copie de fichier

Public Sub ajout_photo()
    Dim dervaleur_a As Integer
    nouveauchemin = "d:\destination" 'à adapter ne pas mettre de \ final
    Set ws = Sheets("photo_doc")
    dervaleur_a = ws.Range("a65000").End(xlUp).Row
    Do
        num_article = InputBox("Indiquer le numéro de l'article", "Quel article?")
        If num_article = "" Then
            Exit Sub    'on sort de la boucle si num_article=""
       Else
            With Application.FileDialog(msoFileDialogOpen)    'choisir un fichier
               .AllowMultiSelect = False
                If .Show = -1 Then
                    dervaleur_a = dervaleur_a + 1    ' la premiere ligne libre
                   ws.Cells(dervaleur_a, 1) = num_article    'on copie le numéro d'article
                   ws.Cells(dervaleur_a, 2) = .SelectedItems(1)    'on copie le nom du fichier
                   fn = Mid(.SelectedItems(1), InStrRev(.SelectedItems(1), "\"))
                   FileCopy .SelectedItems(1), nouveauchemin & fn
               End If
            End With
        End If
    Loop
End Sub

Bonjour,

on y est! Super, merci encore, ça fonctionne au poil.

Oliv