Insertion d'objet sous forme d'icone

Résolu/Fermé
ptitdal - 26 juin 2018 à 13:15
 ptitdal - 2 juil. 2018 à 10:05
Bonjour,

Je suis face à un problème sur un fichier excel.
Je précise que je connait VBA depuis une semaine alors je ne suis pas très fort :)

J'ai créer un userform pour que certaines opération se fasse automatiquement, l'idée étant d'insérer un fichier de n'importe quel extension associé à son icone et au bon endroit.
Pour ce qui de la sélection de la cellule, c'est ok
Pour ce qui est d'afficher une boite de dialog pour insrer l'objet c'est ok

Cependant quand j'insère l'objet il est de taille très grande et toujours blanc sans l'image de l'icone ni le texte associé en dessous.

J'ai utilisé ceci

Private Sub CommandButton2_Click()

Range("c65536").Select 'sélection de la cellule voulu
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select

Dim Obj As OLEObject
Dim Chemin As Variant
Dim Nomfichier As String

Chemin = Application.GetOpenFilename(Title:="Insertion du fichier complémentaire aux explications")
If Chemin = False Then Exit Sub
Application.ScreenUpdating = False

With ActiveSheet
Set Obj = .OLEObjects.Add(Filename:=Chemin, Link:=False, DisplayAsIcon:=True)

End With

End Sub




Sauf que cela ne fonctionne pas comme décrit plus haut et le code "Application.Dialogs(xlDialogInsertObject).Show" ne me permet pas de gérer ce que j'obtiens avec une variable pour faire de la mise en page, donc impossible à utiliser sauf si quelqu'un me donne une astuce pour récupérer l'objet qui est ajouté.
En fouillant il y a bien un numéro d'objet qui s'incrémente de 1 à chaque ajout mais comment je peux faire la mise en page selon l'objet que j'ajoute en dernier...



Enfin j'espère que je suis claire :)

MErci de votre aide

12 réponses

cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
26 juin 2018 à 18:29
Bonjour,

Comme ceci:

Option Explicit
Private Sub CommandButton1_Click()
Dim Obj As OLEObject
Dim Chemin As Variant
Dim Nomfichier As String
Dim Emplacement As Range
Dim derniereLigne As Integer
derniereLigne = Range("D" & Rows.Count).End(xlUp).Row + 1 'n° de la première ligne vide de la colonne D
Chemin = Application.GetOpenFilename(Title:="Insertion du fichier complémentaire aux explications")
If Chemin = False Then Exit Sub
Application.ScreenUpdating = False
 Set Emplacement = Range("D" & derniereLigne)
 With ActiveSheet
Set Obj = .OLEObjects.Add(Filename:=Chemin, Link:=False, DisplayAsIcon:=True)
End With
With Obj.ShapeRange
    .LockAspectRatio = msoFalse
    .Left = Emplacement.Left
    .Top = Emplacement.Top
    .Height = Emplacement.Height
    .Width = Emplacement.Width
End With
Range("D" & derniereLigne) = Obj.ShapeRange.Name
End Sub

0
Alors, ca pourrais le faire, sauf que ma selection de denrière ligne ne peux pas se faire autrement que comme je l'ai fait, parce que toutes les cellules de ma colonne D sont vide par définition (même si un objet peut y être inséré) excel considère la cellule comme vide.

Merci de ton aide en tout cas :)

Il y a un syntaxe pour remplacer ce que tu as mis dans la variable derniereligne par ce que j'ai fait plus haut ? (c'est a dire dernière ligne remplie de la colonne c et se décaler d'une cellule vers la droite)

Autre chose, dans ton code, l'ajout de fichier prend toutes la cellule, je doit pouvoir en ajouter plusieurs (au moins 3) dans la même cellule, avec des petits icones de préférence comme avec la boite de dialog d'ajout d'objets (insertion/objet)
0
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
26 juin 2018 à 19:53
Voilà

Option Explicit
Private Sub CommandButton1_Click()
Dim Obj As OLEObject
Dim Chemin As Variant
Dim Nomfichier As String
Dim Emplacement As Range
Dim derniereLigne As Integer
derniereLigne = Range("C" & Rows.Count).End(xlUp).Row + 1 'n° de la première ligne vide de la colonne C
ActiveCell.Offset(0, 1).Select
Chemin = Application.GetOpenFilename(Title:="Insertion du fichier complémentaire aux explications")
If Chemin = False Then Exit Sub
Application.ScreenUpdating = False
 Set Emplacement = ActiveCell
 With ActiveSheet
Set Obj = .OLEObjects.Add(Filename:=Chemin, Link:=False, DisplayAsIcon:=True)
End With
With Obj.ShapeRange
    .LockAspectRatio = msoFalse
    .Left = Emplacement.Left
    .Top = Emplacement.Top
    .Height = Emplacement.Height
    .Width = Emplacement.Width
End With
ActiveCell.Offset(1, -1).Select
ActiveCell = Obj.ShapeRange.Name
End Sub

0
Ca marche plutot bien, je l'ai adapté légèrement pour ce que je veux.
J'ai encore un problème, mon icone de fichier ne s'affiche pas et le nom du fichier non plus (ou l'emplacement peut importe)
Normalement c'est avec iconlabel ou iconasdisplay mais mais mêmùe en changeant ces valeurs je me retrouve toujours avec un icone blanc et de grand taille !
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
27 juin 2018 à 08:08
Toutes les extensions ne sont pas reconnues, voici un exemple:


0
Je ne vois rien :D
0
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
27 juin 2018 à 08:35
Tu ne vois pas sur l'image les icônes et le nom du fichier! C'est petit.

Je ne sais pas ce que tu cherches à faire, mais je pense qu'il faut que tu voies la chose autrement. Car les images ne sont pas très explicites
0
En fait quand j'ajoute la fichier j'aimerais voir l'icone du fichier correspondant à l'extension et en dessous le chemin d'accès par exemple (comme en utilisant la boite de dialog d'insertion d'objet ==> Insertion/objet)
Quand j'ajoute via OLEObject, je peux gérer la variable en sortie mais je n'arrive pas à voir les icones, c'est juste un carré blanc. Et l'idée c'est que ce soit visible sans que l'opérateur n'ai à faire de mise en page ou de retouche dans le fichier.
0
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
Modifié le 27 juin 2018 à 09:04
Toutes les extensions ne sont pas reconnues

change ceci:

Set Obj = .OLEObjects.Add(Filename:=Chemin, Link:=False, DisplayAsIcon:=True)


par cela:

Set Obj = .OLEObjects.Add(Filename:=Chemin, DisplayAsIcon:=True, IconLabel:=Chemin)


c'est plus net!

voici les extensions reconnues chez moi
TEXTE
IMAGE JPG
EXCEL
IMAGE GIF
IMAGE PNG
0
Fonctionne pas non plus, peut importe ce que je mets comme extension de fichier (word, pdf, image ...)
0
Chez moi ca ne fonctionne pas ... par contre quand je fais un clic droit, objet acrobat (pour un documents pdf) et juste ok, là l'icone s'affiche alors que je ne modifie rien dans les propriété, on pourrait le faire en code VBA cette action ?
Et j'aimerais aussi que la case déplacer et dimmensionner avec les cellule dans format d'objet/onglet propriété soit activé automatiquement aussi

Peut être avec des sendkeys ?

(l'enregistreur de macro ne m'a pas aidé pour tout cela)
0
Peut être que je pourrais réutiliser la ligne Application.Dialogs(xlDialogInsertObject).Show
Et après avec des sendkeys faire automatiquement le boulot que je veux faire pour mettre le fameux fichier
0
J'arrive à quelques chose d'assez bien avec les sendkeys mais je bloque sur un nouveau problème, j'aimerais mettre une variable en tant que numéro d'objet qui s'incrémente de 1.
Sauf que quand je mets le nom de ma variable pour sélectionner le dernier objet ajouté (qui porte le numéro de la variable du coup) ca me met une erreur et qui l'objet est inconnu. Des idées ?

Voici le code

Private Sub CommandButton2_Click()

Range("c65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select


SendKeys ("^{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys (" ")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("~")

Application.Dialogs(xlDialogInsertObject).Show
Dim i As Integer

i = ActiveSheet.Range("H1").Value + 1
ActiveSheet.Range("H1").Value = i


ActiveSheet.Shapes.Range(Array("Object i")).Select









End Sub


L'idée ici est de pouvoir selectionner le dernier objet ajouté avec la variable qui s'incrémente de 1 et de faire des sendkeys à nouveau pour faire ma mise en page automatique. Et j'aurais fini :)
0
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
28 juin 2018 à 09:38
Pour faire ce que tu veux, il faut nommer ta shape et l'incrémenter à chaque fois comme ceci:

Dim Obj As OLEObject
Dim Chemin As Variant
Dim Nomfichier As String
Dim Emplacement As Range
Dim derniereLigne As Integer
Dim i As Integer
i = Range("A1")
derniereLigne = Range("C" & Rows.Count).End(xlUp).Row + 1 'n° de la première ligne vide de la colonne C
ActiveCell.Offset(0, 1).Select
Chemin = Application.GetOpenFilename("Tout fichiers (*.*), *.*")
If Chemin = False Then Exit Sub
Application.ScreenUpdating = False
 Set Emplacement = ActiveCell
 With ActiveSheet
Set Obj = .OLEObjects.Add(Filename:=Chemin, _
            Link:=False, DisplayAsIcon:=True, iconIndex:=0, iconLabel:=Chemin)
End With
With Obj.ShapeRange
    .LockAspectRatio = msoFalse
    .Left = Emplacement.Left
    .Top = Emplacement.Top
    .Height = Emplacement.Height
    .Width = Emplacement.Width
    .Name = "mashape " & i
End With
Range("A1") = i + 1

0
Le truc c'est que je ne peux pas utiliser OLEObject parce que l'icone qui ressort est un grand rectangle blanc sans le nom ni l'image de l'icone qui correspond à l'extension du fichier que j'ajoute ...
C'est pour ca que dans mon code j'utilise la fonction "Application.Dialogs(xlDialogInsertObject).Show", qui me corrige tous ces problèmes ... Les sendkeys c'est pour éviter 15 clics dans le fenêtre de dialogue, c'est plus rapide pour l'utilisateur.

Je cherche simplement une manière de sélectionner le dernier objet qui sort de cette boite de dialogue, soit avec un raccourcis clavier, soit en sélectionnant une cellule et en déclarant que je veux sélectionner l'objet qui est dedans ou une autre méthode que je connait pas, ou alors c'est impossible et là je changerais de manière de faire .. mais en tout cas quand j'utilise ton code j'obtiens pas du tout ce que je veux.

Merci pour ton aide en tout cas, j'avance et je touche du bout du doigt la solution :)
0
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
28 juin 2018 à 10:51
J'ai trouvé, il faut démarrer sans aucune shape sur la feuille et mettre 1 dans la cellule A1. c'est cette cellule qui va incrémenter le numéro de la dernière shape:

Dim Obj As OLEObject
Dim Chemin As Variant
Dim Nomfichier As String
Dim Emplacement As Range
Dim derniereLigne As Integer
Dim i As Integer
Dim shp As Shape
i = Range("A1")
derniereLigne = Range("C" & Rows.Count).End(xlUp).Row + 1 'n° de la première ligne vide de la colonne C
ActiveCell.Offset(0, 1).Select
Chemin = Application.Dialogs(xlDialogInsertObject).Show
If Chemin = False Then Exit Sub
Application.ScreenUpdating = False
 Set Emplacement = ActiveCell
Set shp = Feuil1.Shapes(i) 'adapter le nom de la feuille numero de la dernière  shape correspond à A1
With shp
    .LockAspectRatio = msoFalse
    .Left = Emplacement.Left
    .Top = Emplacement.Top
    .Height = Emplacement.Height
    .Width = Emplacement.Width
    .Name = "mashape " & i
End With
Range("A1") = i + 1


Voilà

@+ Le Pivert
0
Alors par contre ma cellule A1 correspond à autre chose, j'ai mis ton code pour définir i en H1 du coup, mais ca me met un erreur sur la ligne set shp = feuil1.shapes(i)
L'index de cette collection est en dehors de ses limites
I = 16 pour infos parce que l'objet ajouté en dernier et le 16eme (vu par macro enregistrée et en sélectionnant l'objet)
Même chose, j'ai repris ma manière de selectionner la cellule, la tienne me selectionne autre chose je ne sais pas pourquoi mais le résultat est correcte avec le code suivant.

j'ai ajouté les sendkeys pour aller plus vite dans la boite de dialogue.

du coup j'ai ça :

Dim Obj As OLEObject
Dim Chemin As Variant
Dim Nomfichier As String
Dim Emplacement As Range
Dim derniereLigne As Integer
Dim i As Integer
Dim shp As Shape

i = Range("H1")
Range("c65536").Select
Selection.End(xlUp).Select

ActiveCell.Offset(0, 1).Select
SendKeys ("^{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys (" ")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("~")
Chemin = Application.Dialogs(xlDialogInsertObject).Show
If Chemin = False Then Exit Sub
Application.ScreenUpdating = False
Set Emplacement = ActiveCell
Set shp = ActiveSheet.Shapes(i) 'adapter le nom de la feuille numero de la dernière shape correspond à A1
With shp
.Name = "mashape " & i
End With
Range("H1") = i + 1
0
Pour infos, j'ai l'erreur quand i arrive à la valeur 5, en dessous le code a l'air de bien vouloir se faire
0
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
Modifié le 28 juin 2018 à 15:20
Avec ce code je n'ai aucun problème:

Dim Chemin As Variant
Dim Emplacement As Range
Dim i As Integer
Dim shp As Shape

i = Range("H1")
Range("c65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select
SendKeys ("^{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys (" ")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("~")
Chemin = Application.Dialogs(xlDialogInsertObject).Show
If Chemin = False Then Exit Sub
Application.ScreenUpdating = False
Set Emplacement = ActiveCell
Set shp = ActiveSheet.Shapes(i) 'adapter le nom de la feuille numero de la dernière shape correspond à A1
With shp
    .LockAspectRatio = msoFalse
    .Left = Emplacement.Left
    .Top = Emplacement.Top
    .Height = Emplacement.Height
    .Width = Emplacement.Width
    .Name = "mashape " & i
End With
Range("H1") = i + 1


Par contre tes SendKeys désactivent le verrouillage numérique!

SendKeys "{NUMLOCK}"


pour le remettre
0
J'ai réussi d'une façon beaucoup plus simple en fait :)

Dim Chemin As Variant

Dim i As Integer
Dim shp As Shape



i = Range("E1")
Range("c65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, 1).Select

SendKeys ("^{TAB}") 'Sert à sélectionner les coches et afficher la boite parcourir tout de suite sans que l'opérateur n'ait à le faire
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys (" ")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("~")

Application.Wait (Now + TimeValue("0:00:02")) 'temps d'attente pour réactiver le pavé numérique
SendKeys "{NUMLOCK}"

Chemin = Application.Dialogs(xlDialogInsertObject).Show 'affichage de la boite de dialogue d'ajout d'objet

If Chemin = False Then Exit Sub
Application.ScreenUpdating = False


Range("E1") = i + 1
Application.ScreenUpdating = True

Set shp = ActiveSheet.Shapes(i)
shp.Select
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With



'----------------------------------------------------------------------------------------------------
End Sub



Maintenant je voudrais que si je clic une nouvelle fois sur le bouton j'ajoute un autre objet dans la cellule adjacente, cette action se répèterait tant que je n'ai pas rempli une nouvelle ligne, ce qui permettrais d'ajouter plusieurs fichiers.

C'est faisable ou il faut créer un bouton à chaque fois ?
0
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
29 juin 2018 à 14:38
C'est faisable, je te laisse chercher:

http://www.gcexcel.com/trouver-la-cellule-associee-a-une-forme/

Bon courage
0
Je comprends pas tout ! :P

En tout cas merci beaucoup pour ton aide, ca fait quand même une semaine que je bloquais sur ce problème !
je cherche un peu et je posterais mon code pour les gens qui seraient intéressés
0
J'ai regardé ta page, honnêtement j'ai rien compris ^^ En tout cas je n'ai pas réussi à la transposer pour ce que je veux faire ...
0
cs_Le Pivert
Messages postés
7801
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
9 août 2022
714
29 juin 2018 à 15:48
bon plus simple avec un compteur dans le même esprit que pour comptabiliser les shapes
Mettre 1 dans la cellule G1

Dim compteur As Integer
compteur = Range("G1")
Range("c65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, compteur).Select
Range("G1") = compteur + 1


a adapter à ton code
0
J'ai fait un truc pas mal qui sélectionne bien les bonne cellule tout et qui ne gère plus le nombre d'objet en fonction d'une valeur de cellule mais en fonction du nombre d'objet

Tout cela s'ajoute bien dans les bonne cellules, par contre ca le fait automatiquement, je voudrais que la boucle qui ouvre la fenêtre de dialogue se fasse à chaque clic et non en boucle.
En d'autre terme a chaque clic je dois effectuer ce qu'il y a après le while cpt > 5

Voici mon code :

Private Sub CommandButton2_Click()

Dim Chemin As Variant
Dim i As Integer
Dim shp As Shape
Dim cpt As Integer

If ActiveCell.Offset(-1, cpt) = "" Then cpt = Range("U1").Value

While cpt > 5
cpt = 1
Exit Sub
Wend

While cpt < 5

i = ActiveSheet.Shapes.Count
Range("c65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, cpt).Select

SendKeys ("^{TAB}") 'Sert à sélectionner les coches et afficher la boite parcourir tout de suite sans que l'opérateur n'ait à le faire
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys (" ")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("~")

Application.Wait (Now + TimeValue("0:00:02")) 'temps d'attente pour réactiver le pavé numérique suite à la désactivation intempestive
SendKeys "{NUMLOCK}"

Chemin = Application.Dialogs(xlDialogInsertObject).Show 'affichage de la boite de dialogue d'ajout d'objet
If Chemin = False Then Exit Sub

Application.ScreenUpdating = False


Set shp = ActiveSheet.Shapes(i)

shp.Select 'Déplacement avec la cellule de l'objet ajouté en dernier
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
cpt = Range("U1").Value + 1
Application.ScreenUpdating = True
Wend

End Sub
0
J'ai finalement réussi !
Ci joint mon code, qui permet d'ajouter 5 fichiers sous forme d'icones dans 5 cellules adjacentes à une cellule rempli. Au bout du cinquième ajout, un message d'erreur apparait pour vous indiquer que le nombre maximum d'ajout de fichier sur cette ligne est dépassé.

Merci Le Pivert pour ton aide précieuse :) j'ai passé beaucoup de temps là dessus !


Private Sub CommandButton2_Click()


Dim Chemin As Variant
Dim i As Integer
Dim shp As Shape
Dim cpt As Integer



cpt = Range("G1").Value
Range("c65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, cpt).Select

If ActiveCell.Offset(-1, cpt).Value = "" Then DoEvents


If cpt > 5 Then
Range("G1").Value = 1
MsgBox " Limite d'ajout de fichiers par problème dépassée !", 64, "Erreur"
Exit Sub
End If



If cpt <= 5 Then

i = ActiveSheet.Shapes.Count
Range("c65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(0, cpt).Select

SendKeys ("^{TAB}") 'Sert à sélectionner les coches et afficher la boite parcourir tout de suite sans que l'opérateur n'ait à le faire
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys (" ")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("{TAB}")
SendKeys ("~")

Application.Wait (Now + TimeValue("0:00:02")) 'temps d'attente pour réactiver le pavé numérique suite à la désactivation intempestive
SendKeys "{NUMLOCK}"

Chemin = Application.Dialogs(xlDialogInsertObject).Show 'affichage de la boite de dialogue d'ajout d'objet
If Chemin = False Then Exit Sub

Application.ScreenUpdating = False

Set shp = ActiveSheet.Shapes(i)

shp.Select 'Déplacement avec la cellule de l'objet ajouté en dernier
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With

Range("G1").Value = Range("G1").Value + 1
Application.ScreenUpdating = True
End If


End Sub
0