Shape à effacer

Le 04/01/2019 à 11:33

Bonjour,

Je suis toujours avec mes Cartes Grises

Dans le code j'arrive bien à créer et placer la CG. Le problème est que je n'arrive pas à lui fixer un nom pour pouvoir la faire disparaitre ensuite. La photo de la CG a toujours un nom aléatoire du style Picture (plus un nombre indéfini), donc ma macro d'effacement ne fonctionne plus puisque la Picture a changé de numéro. L'idéal aurait été que lorsque je survole mon bouton CG, celle-ci s'affiche et quand je sors du bouton elle disparaisse pour libérer l'écran. Mais d’abord voici où je suis rendue :

Public Sub ShowCG() 'Affiche la Carte Grise
    'Déclaration des Variables
    Dim strDossierCG As String
    Dim strTypImage As String
    Dim strNomPhoto As String
    Dim strConcat As String
    Dim shCG As Shape
    Dim Cpt As Integer
    Dim strUnit As String
    Dim L As Single, T As Single, H As Single, W As Single
    Dim strCG As String

    'Dimensions et position de la Carte Grise
    H = 600 '<-- hauteur
    W = 450 '<-- largeur
    L = 1385 '<-- position horizontale
    T = 0 '<-- position verticale'Insertion de la zone de texte
'    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, L, T, W, H).Select
'    Selection.Name = "CG" & Range("A1").Value '<-- nom de la zone de texte
'
'    Range("A3").Activate '<-- permet de quitter la sélection de la zone de texte

    strUnit = InputBox("Unité où sont localisées les Cartes Grises ? (Clé USB, Disque Dur)", "Choix Unité de Disque", "E")
    strDossierCG = ":\VDL\CG\"
    strNomPhoto = Range("A1")
    strTypImage = ".jpg"

    strConcat = strUnit & strDossierCG & strNomPhoto & strTypImage
    Debug.Print strConcat
    ActiveSheet.Shapes.AddPicture Filename:=strConcat, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=1400, Top:=0, Width:=450, Height:=600
    Efface
End Sub

Et pour effacer

Sub Efface()
    ActiveSheet.Shapes.Range(Array("Picture 7")).Select
    Selection.Delete
    Range("A3").Select
End Sub

C'est le Picture 7 qui me rend folle. Je pensais à hide, show, visible=false ou true enfin déjà faut que je fixe le Picture en le nommant mais là je patine. Une petite aide pour ce début d'année 2019 que je vous souhaite excellente.

Le 04/01/2019 à 12:01

Salut Alessya, et bonne année 2019 également !

Alessya29 a écrit :

C'est le Picture 7 qui me rend folle. Je pensais à hide, show, visible=false ou true

Avec ton exemple de Picture 7 ce sera :

 ActiveSheet.Shapes.Range(Array("Picture 7")).Visible = False

Pour rendre invisible

 ActiveSheet.Shapes.Range(Array("Picture 7")).Visible = True

Pour rendre visible

 ActiveSheet.Shapes.Range(Array("Picture 7")).Delete

Pour supprimer

Après une petite astuce pour connaître le nom de l'image sur laquelle tu clique :

  • Lance l'enregistreur de macro
  • Sélectionne ton image
  • Va voir en VBA ce que tu a de ressorti comme nom

Si sa se trouve, tu n'a pas "Picture 7" mais "Image 7"

Restant à dispo!

Le 04/01/2019 à 13:05

Merci pour la réponse.

Mais ce qui me perturbe, c'est le "Picture XX" qui passe de X à Y à Z une fois qu'il est effacé puis rechargé.

Je suis intéressée par la façon de le renommer en "dur" par une variable. Comme cela c'est le nom en "dur" que j'effacerai sans ambiguïté.

Et dans les propriétés et méthodes de Shape, j'y perds mon latin.

Si tu me dis comment le fixer en dur ce nom aléatoire. J'ai essayé avec ".name" mais je reconnais que je me sens perdue et je ne sais plus ce que j'ai essayé ou pas essayé. A chaque fois, mes essais sont pleins d'erreurs

Le 04/01/2019 à 13:31

Bonjour à tous,

Ci-joint un extrait de code d'une de mes appli.

Dans ce code, je nomme mes shapes avec un préfixe pour pouvoir les effacer facilement quand il y a besoin

Sub Affiche_jpg(lg As Long)
Dim Sh As Shape, ndf As String

    With Sheets("Catalogue").Cells(lg, "D")
        ndf = Ndf_Jpg(.Value)
        If Exist_Fichier(RepJpg & ndf) Then
            Set Sh = Sheets("Catalogue").Shapes.AddPicture(RepJpg & ndf, True, True, _
                    .Left, .Top, .Width, .Height)
            Sh.Name = "Sh" & lg
            Sh.OnAction = "USF"
        End If
    End With
    Set Sh = Nothing
End Sub

Sub RAZ(Optional x As Byte)
Dim Sh As Shape, lg As Long

    With Sheets("Catalogue")
        lg = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("A1:D" & lg).ClearContents
        For Each Sh In .Shapes
            If Sh.Name Like "Sh*" Then Sh.Delete
        Next Sh
    End With
End Sub

Pierre

Le 04/01/2019 à 14:09

Re-

Salut Pierre

Pour renommer un Shape la méthode .Name fonctionne bien :

ActiveSheet.Shapes.Range(Array("Picture 1")).Name = "Sh_1"

Maintenant le Shape qui précédemment s'appelait "Picture 1" s'appel "Sh_1"

Ce qui peut différer c'est la méthode pour le renommer !

  • En cliquant dessus ?
  • En bouclant dessus ?
  • A l'insertion ?

Restant à dispo

Le 04/01/2019 à 16:13

Merci tout le monde.

Je réfléchis un peu et je me dis que le fait de supprimer la Shape pour le recréer après (à la demande de l'utilisateur) va me recréer un Picture avec un n° différent. et donc il serait plus judicieux de cacher la Shape et de la remontrer à la demande ce qui solutionnerait d'où peut-être un hide, show, ou un visible True ou False.

Le problème c'est que sur la feuille j'ai 3 boutons et que si je fais un selectall.delete, ben c'est que mes boutons s'en vont aussi. Donc je dois figer le nom de la Shape Picture impérativement à la création avec le N° de la plaque d'immatriculation (qui est unique) et qui se trouve en A1. Donc je pensais que le survol du bouton CG pourait visualiser la carte grise ex: AA 111 BB dont l'image (Picture X) est collée sur la feuille. Elle pourrait disparaitre (se cacher) ensuite une fois la consultation terminée.

Je vous montre le code que j'utilise pour créer mes feuilles véhicules.

Dans une feuille "Véhicules" j'ai tous les véhicules en colonne A. Cette colonne est balayée pour créer x feuilles correspondant à chaque immat. Une fois qu'elles sont crées suivant un "Modèle" sur laquelle j'ai 3 boutons (dont un CG), dans chaque feuille, au premier clic sur CG, je crée une Shape. Et c'est là le binst. Dois-je cacher et montrer ou supprimer et recréer ?

Option Explicit
Public Sub SuVeh()
    Dim oSh As Worksheet
    Const strongVéhicules As String = "Véhicules"
    Const strongServices As String = "Services"
    Const strongPersonnel As String = "Personnel"
    Const strongOutillage As String = "Outillage"
    Const strongGaranties As String = "Garanties"
    Const strongFournisseurs As String = "Fournisseurs"
    Const strongAchats As String = "Achats"
    Const strongDépenses As String = "Dépenses"
    Const strongPublipostage As String = "Publipostage"
    Const strongCG As String = "Cartes Grises"
    Const strongBD As String = "BD"
    Const strongModèle As String = "Modèle"
        If MsgBox("Suppression des véhicules ?", vbYesNoCancel + vbExclamation) <> vbYes Then
            Exit Sub
        End If
        For Each oSh In Worksheets
        If oSh.Name <> strongVéhicules And _
            oSh.Name <> strongServices And _
            oSh.Name <> strongPersonnel And _
            oSh.Name <> strongOutillage And _
            oSh.Name <> strongGaranties And _
            oSh.Name <> strongFournisseurs And _
            oSh.Name <> strongAchats And _
            oSh.Name <> strongDépenses And _
            oSh.Name <> strongPublipostage And _
            oSh.Name <> strongCG And _
            oSh.Name <> strongBD And _
            oSh.Name <> strongModèle Then
            Application.DisplayAlerts = False
            oSh.Delete
            Application.DisplayAlerts = True
        End If
    Next oSh
End Sub

Public Sub AjVeh()
    Dim oShVéhicules As Worksheet
    Dim oShServices As Worksheet
    Dim oShPersonnel As Worksheet
    Dim oShOutillage As Worksheet
    Dim oShGaranties As Worksheet
    Dim oShFournisseurs As Worksheet
    Dim oShAchats As Worksheet
    Dim oShDépenses As Worksheet
    Dim oShPublipostage As Worksheet
    Dim oShCG As Worksheet
    Dim oShBD As Worksheet
    Dim oShModèle As Worksheet
    Dim iLigFin As Integer
    Dim iLig As Integer
    Dim oShNew As Worksheet
    Dim sNomOnglet As String
    Set oShVéhicules = Worksheets("Véhicules")
    Set oShServices = Worksheets("Services")
    Set oShPersonnel = Worksheets("Personnel")
    Set oShOutillage = Worksheets("Outillage")
    Set oShGaranties = Worksheets("Garanties")
    Set oShFournisseurs = Worksheets("Fournisseurs")
    Set oShAchats = Worksheets("Achats")
    Set oShDépenses = Worksheets("Dépenses")
    Set oShPublipostage = Worksheets("Publipostage")
    Set oShCG = Worksheets("Cartes Grises")
    Set oShBD = Worksheets("BD")
    Set oShModèle = Worksheets("Modèle")

    iLigFin = oShVéhicules.Range("A" & Rows.Count).End(xlUp).Row  'C

    For iLig = 4 To iLigFin
        If oShVéhicules.Range("A" & iLig).Value <> "" Then
            sNomOnglet = oShVéhicules.Range("A" & iLig).Value
            If OngletExist(sNomOnglet) Then
                Set oShNew = Worksheets(sNomOnglet)
            Else
                oShModèle.Copy After:=Worksheets(Worksheets.Count)
                Worksheets(Worksheets.Count).Name = sNomOnglet
                Set oShNew = Worksheets(Worksheets.Count)
                'ShowCG
            End If
            oShNew.Range("A1").Value = oShVéhicules.Range("A" & iLig).Value 'Véhicule
            'oShNew.Range("F3").Value = oShListe.Range("C" & iLig).Value 'Nom
            'lien hypertext
            oShNew.Hyperlinks.Add Anchor:=oShVéhicules.Range("A" & iLig), Address:="", SubAddress:= _
                    "'" & sNomOnglet & "'!A3", TextToDisplay:=oShVéhicules.Range("A" & iLig).Value
            Set oShNew = Nothing
        End If
    Next iLig

    oShVéhicules.Select
    Set oShVéhicules = Nothing
    Set oShServices = Nothing
    Set oShPersonnel = Nothing
    Set oShOutillage = Nothing
    Set oShGaranties = Nothing
    Set oShFournisseurs = Nothing
    Set oShAchats = Nothing
    Set oShDépenses = Nothing
    Set oShPublipostage = Nothing
    Set oShCG = Nothing
    Set oShBD = Nothing
    Set oShModèle = Nothing

End Sub

Private Function OngletExist(psNom As String) As Boolean

    Dim oSh As Worksheet
    Dim lErr As Long
    Dim sErr As String

    On Error Resume Next
    Set oSh = Worksheets(psNom)
    lErr = Err.Number
    sErr = Err.Description
    On Error GoTo 0

    If lErr = 0 Then
        OngletExist = True
    ElseIf lErr = 9 Then
        OngletExist = False
    Else
        MsgBox "Erreur n°" & lErr & vbCrLf & sErr, vbExclamation
    End If

    Set oSh = Nothing

End Function

Le code donné par Juice permet de renommer certes mais "Picture 1" changera de nom à la prochaine ouverture et donc le problème se présentera à nouveau. Ou alors je n'ai pas tout compris dans la manip

ActiveSheet.Shapes.Range(Array("Picture 1")).Name = "Sh_1"

Le code de PierreP56, je n'ai pas eu le temps de le modifier. Il a l'air intéressant, mais je pense que si je pouvais cacher et remontrer la CG à la demande, ça serait plus simple dans la pratique (peut-être pas dans le code). Dans ce cas plus besoin de renommer la Shape Picture.

Bouuhh, je vous donne du souci avec CG. Faut imaginer que ce sont des cartes de voeux !!!

Le 05/01/2019 à 10:46

Finalement je pense avoir résolu le problème du nom de la Shape qui me perturbait.

J'ai modifié mon code :

ActiveSheet.Shapes.AddPicture Filename:=strConcat, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=1400, Top:=0, Width:=450, Height:=600

De la façon suivante :

Set shCG = ActiveSheet.Shapes.AddPicture(Filename:=strConcat, linktofile:=msoFalse, savewithdocument:=msoTrue, Left:=1400, Top:=0, Width:=450, Height:=600)
    shCG.Name = Range("A1").Value
    Range("A3").Activate
Rechercher des sujets similaires à "shape effacer"