Importer images selon caractères d'une case
Résolu
Stridou...
Messages postés
52
Date d'inscription
Statut
Membre
Dernière intervention
-
Stridou... Messages postés 52 Date d'inscription Statut Membre Dernière intervention -
Stridou... Messages postés 52 Date d'inscription Statut Membre Dernière intervention -
Bonjour à tous !
J'ai un fichier Excel 2010 ou je souhaite importer des images contenues dans un fichier de mon réseau.
J'ai un code qui existe, mais pour qu'il cherche dans les bonnes cases, je l'ai décuplé en fonction du nom de la case.(photo fiche 1 / photo fiche 2 ect...)
Je souhaiterais pouvoir créer un code unique (photo fiche) qui :
-lit dans les cases utiles (jaune dans le fichier exemple) si le format est ok (type *****_*****)
- si le format est OK, il importe l'image correspondante (s'il ne trouve pas l'image il affiche le message d'erreur prévu)
- si le format est KO, il ne cherche pas
Voici le fichier avec mon code actuel :
https://www.cjoint.com/?0HzmzmWZTSU
Je me disais qu'il fallait peut être créer un nom à ces cases (j'ai appelé REF_COL dans mon fichier), mais après je ne sais pas comment lui dire de chercher dans ce groupe de cases de faire le tri entre les bons formats et les mauvais formats, ect...
Merci beaucoup de votre aide !
J'ai un fichier Excel 2010 ou je souhaite importer des images contenues dans un fichier de mon réseau.
J'ai un code qui existe, mais pour qu'il cherche dans les bonnes cases, je l'ai décuplé en fonction du nom de la case.(photo fiche 1 / photo fiche 2 ect...)
Je souhaiterais pouvoir créer un code unique (photo fiche) qui :
-lit dans les cases utiles (jaune dans le fichier exemple) si le format est ok (type *****_*****)
- si le format est OK, il importe l'image correspondante (s'il ne trouve pas l'image il affiche le message d'erreur prévu)
- si le format est KO, il ne cherche pas
Voici le fichier avec mon code actuel :
https://www.cjoint.com/?0HzmzmWZTSU
Je me disais qu'il fallait peut être créer un nom à ces cases (j'ai appelé REF_COL dans mon fichier), mais après je ne sais pas comment lui dire de chercher dans ce groupe de cases de faire le tri entre les bons formats et les mauvais formats, ect...
Merci beaucoup de votre aide !
A voir également:
- Importer images selon caractères d'une case
- Caractères ascii - Guide
- Caractères spéciaux - Guide
- Importer favoris chrome - Guide
- Importer favoris firefox - Guide
- Des images - Guide
12 réponses
Est-ce que tu as des connaissances en VBA (macros) ?
Si oui je te donne les astuces, si non je te fais le code :)
Si oui je te donne les astuces, si non je te fais le code :)
Euh, pas beaucoup ! j'ai bidouillé le code moi même, mais ça s'arrête là ! je ne connais pas assez bien les fonctions !
enfin je veux dire, à l'origine le code n'était pas comme ça(ce n'est pas moi qui l'ai fait), je l'ai adapté à mon cas, mais j'arrive pas à l'optimiser !
Alors je peux vous faire le code ce soir, si vous êtes patient ou si personne ne répond avant.
En faite il faut juste me dire quand est-ce que Excel doit aller chercher cette image (Quand on active une feuille, quand on appuie sur un bouton, quand on ajoute du text à une cellule) et ou est-ce qu'il doit aller chercher ces images (Le chemin exacte)
Après je peux faire le reste seul :)
En faite il faut juste me dire quand est-ce que Excel doit aller chercher cette image (Quand on active une feuille, quand on appuie sur un bouton, quand on ajoute du text à une cellule) et ou est-ce qu'il doit aller chercher ces images (Le chemin exacte)
Après je peux faire le reste seul :)
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
REF = toujours information en G6 que je saisis manuellement
COL = information en C22 (pour case jaune en B28) G22 (pour case jaune en F28) ect...
Les informations en C22, G22... arrivent automatiquement grâce à une macro d'extraction lorsque je rentre le code en G6. A partir du moment où la case est remplie, la fonction photo fiche s'active (c'est actuellement ce que fait le code). Parfois la case C22, G22... est vide. les cases B28, F28... sont alors sous la forme REF_
Actuellement le chemin est inscrit en case B3 de la feuille paramètre. Je ne peux malheureusement pas vous donner le chemin car il y a des informations confidentielles dessus... mais s'il s'agit uniquement de copier le chemin en B3 ce sera bon pour moi ! (je pense que c'est ce que fait le code actuellement)
Merci beaucoup de votre aide !
COL = information en C22 (pour case jaune en B28) G22 (pour case jaune en F28) ect...
Les informations en C22, G22... arrivent automatiquement grâce à une macro d'extraction lorsque je rentre le code en G6. A partir du moment où la case est remplie, la fonction photo fiche s'active (c'est actuellement ce que fait le code). Parfois la case C22, G22... est vide. les cases B28, F28... sont alors sous la forme REF_
Actuellement le chemin est inscrit en case B3 de la feuille paramètre. Je ne peux malheureusement pas vous donner le chemin car il y a des informations confidentielles dessus... mais s'il s'agit uniquement de copier le chemin en B3 ce sera bon pour moi ! (je pense que c'est ce que fait le code actuellement)
Merci beaucoup de votre aide !
Je suis désolé je n'ai pas eu le temps de me plongé la dessus. Je vais essayer de ragerder ce week-end.
Super alors vous pouvez mettre le sujet comme résolu alors :)
(pensez à expliquer votre solution )
Encore désolé
(pensez à expliquer votre solution )
Encore désolé
Bonjour,
Voici la solution qui a été trouvée :
Sub Insertion_Image()
Dim Ligne As Long, Colonne As Integer
Dim Image As Shape
Dim Chemin As String, Fichier As String
Dim AdImage As String, Nom As String
Dim iPict As IPictureDisp 'Récupération des dimensions de l'image
Dim NomFichier As String
Dim WiPict As Double, HiPict As Double, t As Double, l As Double, w As Double, h As Double
Dim hImgInit As Double, wImgInit As Double, hImgCoef As Double, wImgCoef As Double
Application.ScreenUpdating = False 'Bloque la mise à jour de l'écran
For Each Image In ActiveSheet.Shapes
If Image.Type = msoPicture Then
Debug.Print Image.TopLeftCell.Address, Image.Name
Image.Delete
End If
Next Image
On Error GoTo Erreur 'Gestion des erreurs, renvoir à l'étiquette Erreur
Chemin = Sheets("PARAMETRES").Range("B3").Value 'Définition du nom et du chemin d'acces à l'imagette
For Ligne = 28 To 80 Step 13
For Colonne = 2 To 6 Step 4
Nom = Cells(Ligne, Colonne) & ".jpg"
AdImage = Chemin & Nom
If Dir(AdImage) <> "" Then
Set iPict = LoadPicture(AdImage)
WiPict = iPict.Width
HiPict = iPict.Height
With Cells(Ligne, Colonne) 'Détermine la position et la dimension de la cellule active
t = .Top
l = .Left
w = .Columns.Width * 2
h = .Rows.Height * 10
End With
Set Image = ActiveSheet.Shapes.AddPicture(AdImage, False, True, l, t, WiPict, HiPict)
With Image
hImgInit = Image.Height 'Détermine la dimension initiale de l'imagette
wImgInit = Image.Width
.Top = h 'Positionne l'imagette dans la cellule active
.Left = l + 1 'Positionne l'imagette dans la cellule a gauche (ak)
.Placement = xlMoveAndSize 'Locks the image so it can be sorted (ak)
hImgCoef = hImgInit / h 'Calcul des coefficients de réduction de l'imagette ( hauteur et largeur )
wImgCoef = wImgInit / w
If wImgInit < hImgInit Then 'Condition pour choisir le coefficient de réduction le plus grand
.Height = h - 2 'Réduction de l'imagette si le coefficient en hauteur est plus grand
.Width = (wImgInit / hImgCoef) - 0
.Top = t - h / 2 'Positionne l'imagette dans la cellule active
.Left = l 'Positionne l'imagette dans la cellule a gauche (ak)
.Placement = xlMoveAndSize
Else
.Height = (hImgInit / wImgCoef) - 0 'Sinon réduction de l'imagette avec le coefficient en largeur
.Width = w - 0
.Top = t - (hImgInit / wImgCoef) / 2 'Positionne l'imagette dans la cellule active
.Left = l 'Positionne l'imagette dans la cellule a gauche (ak)
.Placement = xlMoveAndSize
End If
End With
End If
Next Colonne
Next Ligne
Set iPict = Nothing
Set iPict = Nothing
Application.ScreenUpdating = True 'Réactivation de la mise à jour de l'écran
Exit Sub 'Sortie de la fonction
Erreur: 'Gestion de l'erreur si le chemin n'est pas valide
MsgBox "Pas d'image nommée " & Nom & " dans ce répertoire", vbExclamation, Chemin
End Sub
Voici la solution qui a été trouvée :
Sub Insertion_Image()
Dim Ligne As Long, Colonne As Integer
Dim Image As Shape
Dim Chemin As String, Fichier As String
Dim AdImage As String, Nom As String
Dim iPict As IPictureDisp 'Récupération des dimensions de l'image
Dim NomFichier As String
Dim WiPict As Double, HiPict As Double, t As Double, l As Double, w As Double, h As Double
Dim hImgInit As Double, wImgInit As Double, hImgCoef As Double, wImgCoef As Double
Application.ScreenUpdating = False 'Bloque la mise à jour de l'écran
For Each Image In ActiveSheet.Shapes
If Image.Type = msoPicture Then
Debug.Print Image.TopLeftCell.Address, Image.Name
Image.Delete
End If
Next Image
On Error GoTo Erreur 'Gestion des erreurs, renvoir à l'étiquette Erreur
Chemin = Sheets("PARAMETRES").Range("B3").Value 'Définition du nom et du chemin d'acces à l'imagette
For Ligne = 28 To 80 Step 13
For Colonne = 2 To 6 Step 4
Nom = Cells(Ligne, Colonne) & ".jpg"
AdImage = Chemin & Nom
If Dir(AdImage) <> "" Then
Set iPict = LoadPicture(AdImage)
WiPict = iPict.Width
HiPict = iPict.Height
With Cells(Ligne, Colonne) 'Détermine la position et la dimension de la cellule active
t = .Top
l = .Left
w = .Columns.Width * 2
h = .Rows.Height * 10
End With
Set Image = ActiveSheet.Shapes.AddPicture(AdImage, False, True, l, t, WiPict, HiPict)
With Image
hImgInit = Image.Height 'Détermine la dimension initiale de l'imagette
wImgInit = Image.Width
.Top = h 'Positionne l'imagette dans la cellule active
.Left = l + 1 'Positionne l'imagette dans la cellule a gauche (ak)
.Placement = xlMoveAndSize 'Locks the image so it can be sorted (ak)
hImgCoef = hImgInit / h 'Calcul des coefficients de réduction de l'imagette ( hauteur et largeur )
wImgCoef = wImgInit / w
If wImgInit < hImgInit Then 'Condition pour choisir le coefficient de réduction le plus grand
.Height = h - 2 'Réduction de l'imagette si le coefficient en hauteur est plus grand
.Width = (wImgInit / hImgCoef) - 0
.Top = t - h / 2 'Positionne l'imagette dans la cellule active
.Left = l 'Positionne l'imagette dans la cellule a gauche (ak)
.Placement = xlMoveAndSize
Else
.Height = (hImgInit / wImgCoef) - 0 'Sinon réduction de l'imagette avec le coefficient en largeur
.Width = w - 0
.Top = t - (hImgInit / wImgCoef) / 2 'Positionne l'imagette dans la cellule active
.Left = l 'Positionne l'imagette dans la cellule a gauche (ak)
.Placement = xlMoveAndSize
End If
End With
End If
Next Colonne
Next Ligne
Set iPict = Nothing
Set iPict = Nothing
Application.ScreenUpdating = True 'Réactivation de la mise à jour de l'écran
Exit Sub 'Sortie de la fonction
Erreur: 'Gestion de l'erreur si le chemin n'est pas valide
MsgBox "Pas d'image nommée " & Nom & " dans ce répertoire", vbExclamation, Chemin
End Sub