Faire disparaître des images créées par un Userform car la taille du fichier est trop grande

**prog-amateur** · 26/11/2014, 11h50

BOnjour,

apparemment l'admin me demande 1 sujet = 1 question, alors je me permets de remettre l'historique du sujet global pour que les gens puissent comprendre :
http://www.developpez.net/forums/d14...asseur-entier/

En gros, je rencontre un souci de taille de fichier en créant un fichier via un Userform, voici les détails ci dessous.

Voici le fichier en question.
Excel20.zip

Message à l'admin : l'intégralité du fichier est nécessaire car tout est lié. Je ne peux malheureusement pas mettre qu'une partie de code en balise. Il n'y a aucun problème de confidentialité ni de code trop long. Merci pour votre compréhension.

But du fichier :
Je charge des images sur mon Userform (que je peux les pré-voir dessus), puis je donne un titre au fichier en remplissant la zone de texte.
Ensuite, cela a pour effet de charger les informations sur la Feuille 2.
Quand je clique sur Save, une copie de cette Feuille 2 est enregistrée sur un nouveau classeur (Le nouveau classeur créé ne contient donc que la Feuille 2).

Mon problème :
Quand tout est terminé, j'ai donc le nouveau fichier qui va bien (sur ce point, rien à signaler), mais la Feuille 2 du classeur original (avec le Userform) contient les photos et les informations remplies (titre du texte). Ces images redimensionnées pour l'occasion peuvent faire atteindre plusieurs dizaines de Mo, ce qui rend l'utilisation du Userform très lent.
Surtout qu'en vrai, le Userform que vous voyez sera décliné sur plusieurs feuilles du même classeur (ce qui va multiplier les images sur les autres feuilles du même classeur et entraîner une taille de fichier immense).

Ma demande :
Peut-on envisager de :
Supprimer les photos sur la Feuille 2 du Userform après avoir créé le fichier (ce sont elles qui font prendre beaucoup de taille au fichier) ?
Ou bien une alternative serait *cas idéal* de faire le même process directement dans un nouveau classeur (c'est-à-dire qu'il n'y aurait pas de "Feuille 2" sur le classeur original, mais que tout serait transféré directement sur le nouveau fichier) ?

Merci encore pour votre aide.

**mercatog** · 26/11/2014, 12h07

Ajoute à la fin pour effacer les images de ta feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

TonImage.Picture=LoadPicture()

**prog-amateur** · 26/11/2014, 15h15

Merci beaucoup mercatog.

J'ai essayé de mettre ton code à la fin (dans la partie "Save" étant donné que je veux qu'elles disparaissent après avoir cliqué, mais sans succès.
Qu'est-ce qui cloche à ton avis ? Voir ci-dessous en rouge :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Private Sub Save_Click()
Dim Classeur_Source As Workbook, Classeur_Destination As Workbook
Set Classeur_Source = ThisWorkbook 'classeur initial
Dim nom As String
    nom = TextBox1
    Classeur_Source.Sheets(2).Copy
    Set Classeur_Destination = ActiveWorkbook 'ici le classeur de la copie de la feuille
    ActiveWorkbook.SaveCopyAs Classeur_Source.Path & "\" & nom & ".xls" 'qu'on enregistre sous un autre nom
    Classeur_Destination.Close False 'puis que l'on ferme
    rep = MsgBox("File registered as : " & nom, vbYes + vbInformation, "Copie sauvegarde classeur")
    '
'
' MacroRedimension Macro
'

'
    Sheets("CR").Select
    Columns("B:B").ColumnWidth = 79.29
    Columns("B:B").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A1").Select
    Image1.Picture = LoadPicture()
    Image2.Picture = LoadPicture()
End Sub