Importer images selon caractères d'une case
Résolu/Fermé
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
-
25 août 2014 à 14:38
Stridou... Messages postés 52 Date d'inscription mardi 29 juillet 2014 Statut Membre Dernière intervention 22 octobre 2014 - 28 août 2014 à 15:17
Stridou... Messages postés 52 Date d'inscription mardi 29 juillet 2014 Statut Membre Dernière intervention 22 octobre 2014 - 28 août 2014 à 15:17
A voir également:
- Importer images selon caractères d'une case
- Caractères ascii - Guide
- Caractères spéciaux symboles clavier - Guide
- Caractères spéciaux - Guide
- Clavier mac caractères spéciaux - Guide
- Importer contact - Guide
12 réponses
skk201
Messages postés
938
Date d'inscription
jeudi 11 septembre 2008
Statut
Membre
Dernière intervention
16 octobre 2016
54
25 août 2014 à 14:41
25 août 2014 à 14:41
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 :)
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
25 août 2014 à 14:43
25 août 2014 à 14:43
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 !
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
25 août 2014 à 14:47
25 août 2014 à 14:47
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 !
skk201
Messages postés
938
Date d'inscription
jeudi 11 septembre 2008
Statut
Membre
Dernière intervention
16 octobre 2016
54
25 août 2014 à 14:47
25 août 2014 à 14:47
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
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
25 août 2014 à 15:52
25 août 2014 à 15:52
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 !
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
25 août 2014 à 16:03
25 août 2014 à 16:03
Voici ce que ça donnerait:
https://www.cjoint.com/?0HzqcSz1JuN
https://www.cjoint.com/?0HzqcSz1JuN
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
27 août 2014 à 10:20
27 août 2014 à 10:20
Je ne sais pas si mon fichier est très clair !
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
27 août 2014 à 11:47
27 août 2014 à 11:47
Bonjour,
La solution a été trouvée, merci !
La solution a été trouvée, merci !
skk201
Messages postés
938
Date d'inscription
jeudi 11 septembre 2008
Statut
Membre
Dernière intervention
16 octobre 2016
54
27 août 2014 à 13:02
27 août 2014 à 13:02
Je suis désolé je n'ai pas eu le temps de me plongé la dessus. Je vais essayer de ragerder ce week-end.
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
27 août 2014 à 14:23
27 août 2014 à 14:23
Ne vous embêtez pas, la solution a déjà été trouvé ! Merci beaucoup en tout cas !
skk201
Messages postés
938
Date d'inscription
jeudi 11 septembre 2008
Statut
Membre
Dernière intervention
16 octobre 2016
54
27 août 2014 à 15:45
27 août 2014 à 15:45
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é
Stridou...
Messages postés
52
Date d'inscription
mardi 29 juillet 2014
Statut
Membre
Dernière intervention
22 octobre 2014
28 août 2014 à 15:17
28 août 2014 à 15:17
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
