XL 2010 Modification de la taille d'une icone et "Si présence"

[Laosurlamontagne]

Bonjour à tous,

J'utilise la fonction suivante pour insérer un fichier sous forme d'icone:

Application.Dialogs(xlDialogInsertObject).Show

Simple et efficace, néanmoins, je trouve l'icone trop grosse. Auriez-vous une idée pour modifier (par macro) sa taille et éventuellement la couleur du fond et son contour?

J'ai une autre question: existerait-il une commande VB qui me permettrait de vérifier si un objet est présent sur telle ou telle cellule? Dans mon cas, la commande précédente m’insère le fichier sur la dernière cellule sélectionnée, disons B10, et je voudrais vérifier que le fichier soit bien présent...

Auriez-vous des idées?

 

[Lone-wolf]

Bonjour Laosurlamontagne

Là tu demande trop. Sinon regarde ici si tu touve ton bonheur

Sinon je te propose ce fichier. Une fois l'icône créé, clique sur l'icône pour afficher le classeur.

Et pour verifier l'existance d'un fichier

Public Function FichierExiste(S As String) As Boolean
Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    FichierExiste = fso.FileExists(S)
End Function


Sub Test()
Dim Fichier$

Fichier = "C:\Mes documents\Classeur1.xls"
If FichierExiste(Fichier) then _
MsgBox "Vous lui voulez quoi ?", vbInformation, "Le fichier est bien vivant."
Else
MsgBox "Vous voulez l'appelez ?", vbExclamation, "Le fichier est mort."
End If
End Sub

 

[Laosurlamontagne]

On peut rêver dans les nuages, non?!

Merci.

 

[PMO2]

Bonjour,

Une autre approche et on oublie Application.Dialogs(xlDialogInsertObject).Show
Copiez le code suivant dans un module standard :

Sub aa()
Dim Reponse As Variant
Dim FileName$
Dim SH As Shape
'--- Choix d'un fichier ---
Reponse = Application.GetOpenFilename( _
    FileFilter:="Tout fichier (*.*), *.*", _
    Title:="Insérer un fichier sous forme d'icône dans la cellule active")
If Reponse = False Then Exit Sub
FileName$ = Mid(Reponse, InStrRev(Reponse, "\") + 1)
'--- Le fichier est-il déjà présent ? ---
On Error Resume Next
For Each SH In ActiveSheet.Shapes
  If SH.AlternativeText = Reponse Then
    Range(SH.TopLeftCell.Address).Select
    MsgBox prompt:="Le fichier ''" & Reponse & "'' existe déjà" & vbLf & _
          " en cellule " & SH.TopLeftCell.Address(False, False), _
          Title:="Le fichier sous forme d'icône existe déjà"
    Exit Sub
  End If
Next SH
On Error GoTo 0

Application.ScreenUpdating = False
'--- Crée la Shape ---
Set SH = ActiveSheet.Shapes.AddOLEObject( _
    FileName:=Reponse, DisplayAsIcon:=True, _
    IconFileName:=Application.Path & "\" & "excel.exe", _
    IconIndex:=10, IconLabel:=FileName$)
'--- Propriétés de la Shape ---
SH.AlternativeText = Reponse  'Identificateur unique
SH.TopLeftCell = ActiveCell   'Localisation sur cellule
    '°°° Taille °°°
SH.Width = 40
SH.Height = 40
    '°°° Couleur du fonds °°°
SH.Fill.ForeColor.RGB = vbYellow
    '°°° Contour °°°
SH.Line.ForeColor.RGB = vbRed
SH.Line.Weight = 1.75
'---
Application.ScreenUpdating = True
End Sub

Modifiez taille et couleur dans les parties indiquées par des °°°

 

[Laosurlamontagne]

Dis-donc... ça marche du feu de Dieu !!! Merci ! C'est exactement ce que je recherchais (et en mieux!! car on ne navigue pas dans les menus de l'ajout d'objet)

 

[Laosurlamontagne]

Coucou à tous,

Je re-ouvre ce fil avec une question encore bien tordue. La macro de PMO2 est excellente et je voudrais encore l'affiner.

L'icone est "posée" sur la dernière cellule sélectionnée, facile. Cependant, serait-il possible de positionner l’icône sur une zone identifiée, par exemple un "label" ou une image (intégrée par "Developpeur" -> "Insérer" -> ...)?

 

[PMO2]

L'icone est "posée" sur la dernière cellule sélectionnée, facile. Cependant, serait-il possible de positionner l’icône sur une zone identifiée, par exemple un "label" ou une image (intégrée par "Developpeur" -> "Insérer

Cela dépend s'il s'agit d'un "Contrôle de formulaire" ou d'un "Contrôle ActiveX".
Les contrôles cités (Label, Image) appartiennent à quelle catégorie ?

 

[Laosurlamontagne]

J'hésite toujours entre les 2 !

Je crois que c'est "Contrôle ActiveX" où on peut "nommer" les objets... Mais si c'est l'inverse, ça me va aussi!!

 

[Laosurlamontagne]

Je crois que j'ai trouvé...

  Set champ = ActiveSheet.Shapes("Image1")
  SH.Top = champ.Top
  SH.Left = champ.Left

Simple en fait !!