VBA pop up

anasimo · 1 Novembre 2019

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 · 2 Novembre 2019

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 · 2 Novembre 2019

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

job75 · 2 Novembre 2019

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

VB:

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 · 2 Novembre 2019

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 · 2 Novembre 2019

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 · 2 Novembre 2019

Fichier (3) avec .PictureSizeMode = fmPictureSizeModeClip

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

jcf6464 · 2 Novembre 2019

Bonjour à vous tous et le forum,

sur excel 2016,

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

a+ jcf

job75 · 2 Novembre 2019

Bonjour jcf6464, merci d'avoir testé.

job75 · 2 Novembre 2019

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

VB:

P.CopyPicture xlScreen, xlBitmap

patricktoulon · 2 Novembre 2019

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 · 2 Novembre 2019

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

anasimo · 2 Novembre 2019

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 · 2 Novembre 2019

re

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

VB:

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 · 2 Novembre 2019

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 · 2 Novembre 2019

anasimo à dit:
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 :

VB:

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.

VBA pop up

anasimo

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

anasimo

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

anasimo

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

jcf6464

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Pièces jointes

patricktoulon

XLDnaute Barbatruc

anasimo

XLDnaute Occasionnel

anasimo

XLDnaute Occasionnel

Pièces jointes

patricktoulon

XLDnaute Barbatruc

anasimo

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

Discussions similaires