userform flottante

sigma

XLDnaute Occasionnel
Bonjour à tous,

j'ai un tableau que j'aimerai insérer dans un userform ou une list box flottante pour pouvoir la promener sur ma feuille.

j'ai tenté via une list box mais il ne prend pas la mise en forme initiale des cellules en compte.

quelqu'un aurait il une idée sur ce sujet ?

Merci à tous.

A+
 

Pièces jointes

  • test userform flottante.xls
    16.5 KB · Affichages: 87

PMO2

XLDnaute Accro
Re : userform flottante

Bonjour,

Une piste avec les codes suivants

1) créez un UserForm1 et un contrôle Image1
2) dans la fenêtre de code du UserForm, copiez le code suivant
Code:
Private Sub UserForm_Terminate()
Sortir = True
End Sub
3) dans un module standard, copiez le code suivant (adaptez éventuellement les constantes cernées par des ###)
Code:
'### Constantes à adapter ###
Const FEUILLE As String = "Test"
Const PLAGE As String = "a1:b5"
Const TEMPO_JPG As String = "__pmo.jpg"
'############################

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Sortir As Boolean

Sub LanceUSF()
Dim S As Worksheet
Dim OldR As Range
Dim R As Range
Dim OL As OLEObject
Dim SH As Shape
Dim CO As ChartObject
Dim IM As MSForms.Image
Dim Chemin$
Chemin$ = ActiveWorkbook.Path & "\" & TEMPO_JPG & ""
Set S = ActiveSheet
Set OldR = ActiveCell
Set R = Sheets(FEUILLE).Range(PLAGE)

Application.ScreenUpdating = False
Set OL = S.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, _
    Left:=ActiveWindow.Left, Top:=ActiveWindow.Top, Width:=1, Height:=1)
OL.Select
R.Copy
S.Paste
OL.Delete
Set OL = Nothing
Set SH = S.Shapes(Selection.Name)
SH.Copy
SH.Delete
Set SH = Nothing
Set CO = S.ChartObjects.Add(R.Left, R.Top, R.Width, R.Height)
With CO.Chart
  .Paste
  .Export Filename:=Chemin$
End With
CO.Delete
Set CO = Nothing
OldR.Select
With UserForm1
  .Show vbModeless
  Set IM = .Image1
  IM.Picture = LoadPicture(Chemin$)
  IM.AutoSize = True
  IM.Left = 0
  IM.Top = 0
  .Height = IM.Height + 25
  .Width = IM.Width
  .Caption = "Feuille " & FEUILLE & " - Plage " & R.Address(False, False, xlA1)
  .Show vbModeless
End With
Application.ScreenUpdating = True
Set R = Nothing
Set IM = Nothing
Set OldR = Nothing
Kill Chemin$
Do
  DoEvents
  If Sortir Then
    Unload UserForm1
    Sortir = False
    Exit Do
  End If
  Sleep 5
Loop
End Sub
4) renommez la feuille 1 du classeur "Test" et renseignez la plage A1:B5

Lancez la macro LanceUSF

Cordialement.

PMO
 

Discussions similaires

  • Résolu(e)
Microsoft 365 Taille UserForm
Réponses
3
Affichages
355

Statistiques des forums

Discussions
312 330
Messages
2 087 337
Membres
103 524
dernier inscrit
Smile1813