Insertion d'objet sous forme d'icone
Résolu/Fermé
A voir également:
- Insérer un fichier excel dans word sous forme d'icone
- Mise en forme conditionnelle excel - Guide
- Insérer signature word - Guide
- Fichier rar - Guide
- Word et excel gratuit - Guide
- Insérer liste déroulante excel - Guide
12 réponses
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
26 juin 2018 à 18:29
26 juin 2018 à 18:29
Bonjour,
Comme ceci:
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
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)
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)
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
26 juin 2018 à 19:53
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
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 !
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 !
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
27 juin 2018 à 08:08
27 juin 2018 à 08:08
Toutes les extensions ne sont pas reconnues, voici un exemple:
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
27 juin 2018 à 08:35
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
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
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.
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.
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
Modifié le 27 juin 2018 à 09:04
Modifié le 27 juin 2018 à 09:04
Toutes les extensions ne sont pas reconnues
change ceci:
par cela:
c'est plus net!
voici les extensions reconnues chez moi
TEXTE
IMAGE JPG
EXCEL
IMAGE GIF
IMAGE PNG
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
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)
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)
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
Et après avec des sendkeys faire automatiquement le boulot que je veux faire pour mettre le fameux fichier
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
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 :)
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 :)
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
28 juin 2018 à 09:38
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
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 :)
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 :)
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
28 juin 2018 à 10:51
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:
Voilà
@+ Le Pivert
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
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 :
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
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
Modifié le 28 juin 2018 à 15:20
Modifié le 28 juin 2018 à 15:20
Avec ce code je n'ai aucun problème:
Par contre tes SendKeys désactivent le verrouillage numérique!
pour le remettre
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
J'ai réussi d'une façon beaucoup plus simple en fait :)
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 ?
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 ?
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
29 juin 2018 à 14:38
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
http://www.gcexcel.com/trouver-la-cellule-associee-a-une-forme/
Bon courage
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 ...
cs_Le Pivert
Messages postés
7904
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
14 août 2024
729
29 juin 2018 à 15:48
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
a adapter à ton code
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
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 :
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
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 !
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