VBA pop up

[anasimo]

Bonjour

j'ai une feuille où je vais mettre une liste des abréviations (tableau de 2 colonnes et 25 lignes) ...pour ne pas encombrer mon classeur je veux supprimer cette feuille
Y a un moyen de mettre un bouton cliquable pour avoir 1 popup ou s'affiche ce tableau (excel ou word peut importe)

Merci pour votre aide

 

[patricktoulon]

re
il faut faire attention la prochaine fois que tu envoie un fichier!!
la je suis même obligé d'enlever le code car les données sont les mêmes

 

[anasimo]

oui il faut supprimer le code (je l'ai déja copié).....merci beaucoup

 

[job75]

L'instruction .Parent.Activate du fichier (1) ne me plaît pas, j'ai modifié le code dans ce fichier (2) :

Sub POP_UP()
Dim P As Range, fichier$
Set P = Sheets("Liste").[A1].CurrentRegion 'la feuille Liste est masquée
fichier = ThisWorkbook.Path & "\MonImage.gif"
'---création du fichier image gif---
P.CopyPicture
With P.Parent.ChartObjects.Add(0, 0, P.Width, P.Height).Chart
    While .Shapes.Count = 0 'en attente du collage
        DoEvents
        .Paste
    Wend
    .Export fichier, "GIF"
    .Parent.Delete 'supprime le graphique temporaire
End With
'---dimensionnement et remplissage de l'UserForm---
With UserForm1
    .Width = P.Width
    .Height = P.Height + 20
    .PictureSizeMode = fmPictureSizeModeStretch
    .Picture = LoadPicture(fichier)
    Kill fichier 'suppression du fichier image
    .Show
End With
End Sub

 

[anasimo]

Merci beaucoup Job..il est bien fait et répond à mes attentes.
@patrick
Au vu des captures ton code me parait aussi intéressant (je veux l'utiliser pour un autre cas: un tableau des contrôles à réaliser) mais je ne sais comment l'utiliser (c pas 1 macro c ça?)
Merci beaucoup les gars

 

[job75]

Chez moi sur Excel 2019 (64 bits) je constate que l'image créée n'est pas parfaite :

- la bordure entre la 5ème et la 6ème ligne est plus épaisse

- certaines lettres sont mal affichées : le n de Action, le t de petite, le r de amortissement.

Est-ce la même chose chez vous ?

 

[job75]

Fichier (3) avec .PictureSizeMode = fmPictureSizeModeClip

Je n'ai plus de problème avec les lettres mais le problème de la bordure subsiste.

 

[jcf6464]

Bonjour à vous tous et le forum,

sur excel 2016,

Même remarque que job75 pour l'affichage des lettres et traie,

a+ jcf

 

[job75]

Bonjour jcf6464, merci d'avoir testé.

 

[job75]

Bon pour le problème des bordures voyez ce fichier (4) et l'instruction :

P.CopyPicture xlScreen, xlBitmap

 

[patricktoulon]

re
oui Job75 c'est normal
copypicture = window media file(WMF)
chart export = JPG,GIF(1frame)
ça crée toujours des petit défaut comme ça et en plus c'est aléatoire; des fois c'est pas au même endroit
j'avais résolu le problème au dimensionnement du chart légèrement supérieure a a range mais c'est pas parfait

 

[anasimo]

chez moi c'est en Full HD en fait ça dépend de la police utilisée...ici c calibri light ça donne

 

[anasimo]

job
votre code popup m'a beaucoup plu...et je veux l'utiliser pour un autre cas ...y a pas moyen de d'ajouter au code pour délimiter la zone d'affichage...pour permettre d'afficher juste une partie d'un grand tableau ..
je te donne un exemple...j'ai tableau de A1:E100.....dans un bouton je veux un popup de D1;E17 ...un popoup de D1;E38.....etc
j'ai un grand tableau (de série de contrôle à réaliser réparties par thème )...je vais mettre 6 boutons (un/thème) cliquable qui affiche cette partie de tableau dédiée à ce theme

voir feuille controle de la PJ

 

[patricktoulon]

re

et si on revenais au base
fait moi plaisir test ca dans un userform

Private Sub UserForm_Activate()
    For i = 1 To Sheets("liste").Cells(Rows.Count, "A").End(xlUp).Row
        With Me.Controls.Add("Forms.Label.1", "Bt" & i, True)
            Set cel = Sheets("liste").Cells(i, "A")
            .Caption = cel
            .Top = 18 * (i - 1)
            .Left = 0
            .Width = cel.Width
            .Height = 18
            .BackColor = cel.Interior.Color
            .Font.Name = cel.Font.Name
            .ForeColor = cel.Font.Color
            .Font.Bold = cel.Font.Bold
            .Font.Size = cel.Font.Size
            .TextAlign = IIf(cel.HorizontalAlignment = xlCenter, 2, 1)
            .BorderStyle = 1: .BorderColor = &HFFFFC0
        End With
        With Me.Controls.Add("Forms.Label.1", "Bt2" & i, True)
            .Caption = cel.Offset(, 1)
            .Top = 18 * (i - 1)
            .Left = cel.Width + 1
            .Width = cel.Offset(, 1).Width
            .Height = 18
            .BackColor = cel.Offset(, 1).Interior.Color
            .Font.Name = cel.Offset(, 1).Font.Name
            .ForeColor = cel.Offset(, 1).Font.Color
            .Font.Bold = cel.Offset(, 1).Font.Bold
            .Font.Size = cel.Offset(, 1).Font.Size
            .TextAlign = IIf(cel.Offset(, 1).HorizontalAlignment = xlCenter, 2, 1)
            .BorderStyle = 1: .BorderColor = &HFFFFC0
        End With
    Next

    Me.Height = (i * 18)
    Me.Width = Sheets("liste").Range("A1:B1").Width
End Sub

avec ca tu n'aura aucun probleme de restitution

et certainement plus rapide q'une capture exporté

 

[anasimo]

merci patrick...ça vous dérange pas de le mettre dans le fichier et le téléverser....j'y connais rien en userform

 

[job75]

y a pas moyen de d'ajouter au code pour délimiter la zone d'affichage...pour permettre d'afficher juste une partie d'un grand tableau ..

Voyez ce fichier (5) avec 3 boutons et la macro :

Sub POP_UP()
Dim P As Range, fichier$
Set P = Sheets("Liste").[A1].CurrentRegion 'la feuille Liste est masquée
P.EntireRow.Hidden = True
Select Case Val(Right(ActiveSheet.DrawingObjects(Application.Caller).Text, 1))
    Case 1: P.Rows("1:6").Hidden = False
    Case 2: P.Rows("1:11").Hidden = False
    Case 3: P.EntireRow.Hidden = False
End Select
fichier = ThisWorkbook.Path & "\MonImage.gif"
'---création du fichier image gif---
P.CopyPicture xlScreen, xlBitmap
With P.Parent.ChartObjects.Add(0, 0, P.Width, P.Height).Chart
    While .Shapes.Count = 0 'en attente du collage
        DoEvents
        .Paste
    Wend
    .Export fichier, "GIF"
    .Parent.Delete 'supprime le graphique temporaire
End With
'---dimensionnement et remplissage de l'UserForm---
With UserForm1
    .Width = P.Width
    .Height = P.Height + 30
    .PictureSizeMode = fmPictureSizeModeClip
    .Picture = LoadPicture(fichier)
    Kill fichier 'suppression du fichier image
    .Show
End With
End Sub

Il suffit donc de masquer les lignes et/ou les colonnes indésirables.