Effacer les images avant la fermeture

Bonsoir tout le monde,

Deuxième jour, deuxième problème .

J'ai cherché partout sur google pourtant...

Merci pour l'attention que vous porterez à ma demande.

J'ai un fichier Excel qui a beaucoup de composants image. Environ 300 sur différents onglets.

Excel charge ces images selon les lignes de code suivantes :

Private Sub Workbook_Activate()

Dim soussousrepertoire As String, sousrepertoire As String, repertoire As String

soussousrepertoire = Range("H55")

sousrepertoire = Range("I55")

repertoire = Range("J55")

NomUtilisateur = Environ("username")

If Dir("c:\Users\" + NomUtilisateur + "\Dropbox\Applications\C\" + soussousrepertoire + "\" + sousrepertoire + "\" + repertoire + "\Facade\1.jpg") <> "" Then

Sheets("LE BIEN").Image1.Picture = LoadPicture("c:\Users\" + NomUtilisateur + "\Dropbox\Applications\C\" + soussousrepertoire + "\" + sousrepertoire + "\" + repertoire + "\Facade\1.jpg")

Else

Sheets("LE BIEN").Image1.Picture = LoadPicture("")

End If

Application.ScreenUpdating = True

End Sub

Mon soucis est que je ne veux pas que excel les enregistre dans mon classeur lorsque je l'enregistre.

Simplement par mon fichier atteint très vite les 500Mo et devient impossible à ouvrir.

Je pense avoir tout essayé mais je bloque vraiment.

J'ai essayé de mettre

Sheets("LE BIEN").Image1.Picture = LoadPicture("") dans Private Sub Workbook_BeforeClose(Cancel As Boolean) mais ça ne marche pas.

Merci pour votre aide.

Damien

Bonsoir,

Mon soucis est que je ne veux pas que excel les enregistre dans mon classeur lorsque je l'enregistre.

BeforeClose n'est pas BeforeSave...

Bonjour,

Merci pour votre réponse.

Vous avez entièrement raison donc je viens de le changer mais malgré tout ça ne marche pas.

Si vois avez d'autres idées, je suis preneur.

Merci encore

Bonjour,

Quelle est ta procédure ?

Bonjour,

Merci encore de prendre le temps de me répondre.

J'ai une photo sur la première feuille et ensuite une trentaine de photos à partir de la feuille 8.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim i As Integer

Dim Chemin As String

i = 1

Application.ScreenUpdating = False

For i = 1 To Sheets.Count - 1

If (i = 1) Then

Sheets(i).Select

Sheets(i).Image1.Picture = LoadPicture("")

End If

If (i > 7) Then

Sheets(i).Select

Sheets(i).Image1.Picture = LoadPicture("")

Sheets(i).Image2.Picture = LoadPicture("")

Sheets(i).Image3.Picture = LoadPicture("")

Sheets(i).Image4.Picture = LoadPicture("")

Sheets(i).Image5.Picture = LoadPicture("")

Sheets(i).Image6.Picture = LoadPicture("")

Sheets(i).Image7.Picture = LoadPicture("")

Sheets(i).Image8.Picture = LoadPicture("")

Sheets(i).Image9.Picture = LoadPicture("")

Sheets(i).Image10.Picture = LoadPicture("")

Sheets(i).Image11.Picture = LoadPicture("")

Sheets(i).Image12.Picture = LoadPicture("")

Sheets(i).Image13.Picture = LoadPicture("")

Sheets(i).Image14.Picture = LoadPicture("")

Sheets(i).Image15.Picture = LoadPicture("")

Sheets(i).Image16.Picture = LoadPicture("")

Sheets(i).Image17.Picture = LoadPicture("")

Sheets(i).Image18.Picture = LoadPicture("")

Sheets(i).Image19.Picture = LoadPicture("")

Sheets(i).Image20.Picture = LoadPicture("")

Sheets(i).Image21.Picture = LoadPicture("")

Sheets(i).Image22.Picture = LoadPicture("")

Sheets(i).Image23.Picture = LoadPicture("")

Sheets(i).Image24.Picture = LoadPicture("")

Sheets(i).Image25.Picture = LoadPicture("")

Sheets(i).Image26.Picture = LoadPicture("")

Sheets(i).Image27.Picture = LoadPicture("")

Sheets(i).Image28.Picture = LoadPicture("")

Sheets(i).Image29.Picture = LoadPicture("")

Sheets(i).Image30.Picture = LoadPicture("")

Sheets(i).Image31.Picture = LoadPicture("")

Sheets(i).Image32.Picture = LoadPicture("")

Sheets(i).Image33.Picture = LoadPicture("")

Sheets(i).Image34.Picture = LoadPicture("")

Sheets(i).Image35.Picture = LoadPicture("")

Sheets(i).Image36.Picture = LoadPicture("")

Sheets(i).Image37.Picture = LoadPicture("")

End If

Next i

Sheets("LE BIEN").Select

Sheets("LE BIEN").Image1.Picture = LoadPicture("")

Application.ScreenUpdating = True

End Sub

C'est quand même très étrange, je m'explique :

J'enregistre et mon fichier fait 45Mo.

Je réenregistre et il fait 800Ko...

J'y comprends plus rien

Bonjour,

Une simplification du code :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

    Dim i As Integer
    Dim J As Integer

    Application.ScreenUpdating = False

    For i = 1 To Sheets.Count - 1

        If i = 1 Then Sheets(i).Image1.Picture = LoadPicture("")

        If i > 7 Then

            For J = 1 To 37: Sheets(i).OLEObjects(J).Object.Picture = LoadPicture(""): Next J

        End If

    Next i

    Sheets("LE BIEN").Select
    Sheets("LE BIEN").Image1.Picture = LoadPicture("")

    Application.ScreenUpdating = True

End Sub

Bonjour,

Essaie ainsi :

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim i%, j%, Chemin$, ws As Worksheet
    Application.ScreenUpdating = False
    For i = 1 To Worksheets.Count - 1
        If i = 1 Then
            Worksheets(i).OLEObjects("Image1").Object.Picture = LoadPicture("")
        ElseIf (i > 7) Then
            With Worksheets(i)
                For j = 1 To 37
                    .OLEObjects("Image" & j).Object.Picture = LoadPicture("")
                Next j
            End With
        End If
    Next i
    Worksheets("LE BIEN").OLEObjects("Image1").Object.Picture = LoadPicture("")
 End Sub

NB- N'oublie pas les balises Code pour citer du code, la prochaine fois...

Cordialement.

Wahou quelle simplification . On voit les années d'excel derrière .

Merci encore.

La première fois il me génère un fichier appelé 1E46F400 qui grossit jusqu'à atteindre 45Mo (j'ai joint le fichier).

Ces 45Mo sont ensuite intégrés dans le xlsm.

Au deuxième enregistrement, le fichier fait 800Ko