Insertion d'objet sous forme d'icone

Résolu
ptitdal -  
 ptitdal -
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

Résumé de la discussion

La discussion porte sur l’insertion d’un fichier via VBA dans Excel à partir d’un formulaire, avec DisplayAsIcon et xlDialogInsertObject, et l’objet apparaît comme un grand rectangle blanc sans icône ni texte. Plusieurs réponses expliquent des méthodes pour récupérer et mettre en page l’objet inséré, notamment en utilisant la boîte de dialogue xlDialogInsertObject puis en repérant le dernier Shape inséré. En pratique, il faut compter les objets, récupérer la forme par index puis la sélectionner pour définir son placement et l’activer en PrintObject, afin d’enchaîner les ajouts dans la cellule adjacente. En pratique, il est ensuite possible d’ajouter plusieurs fichiers dans la même cellule en répétant l’opération, sans bouton supplémentaire, toutefois certaines extensions restent non reconnues par la boîte de dialogue.

Bobot (l'IA à votre service)
  1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  2. ptitdal
     
    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
  3. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
  4. ptitdal
     
    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

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

    Posez votre question
  6. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    Toutes les extensions ne sont pas reconnues, voici un exemple:


    0
    1. ptitdal
       
      Je ne vois rien :D
      0
    2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      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
    3. ptitdal
       
      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
    4. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      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
    5. ptitdal
       
      Fonctionne pas non plus, peut importe ce que je mets comme extension de fichier (word, pdf, image ...)
      0
  7. ptitdal
     
    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
  8. ptitdal
     
    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
  9. ptitdal
     
    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
  10. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
     
    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
    1. ptitdal
       
      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
    2. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      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
    3. ptitdal
       
      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
    4. ptitdal
       
      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
    5. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      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
  11. ptitdal
     
    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
    2. ptitdal
       
      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
  12. ptitdal
     
    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
    1. cs_Le Pivert Messages postés 8437 Statut Contributeur 730
       
      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
    2. ptitdal
       
      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
  13. ptitdal
     
    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