Bestands grootte

Status
Niet open voor verdere reacties.
D

DutchOirs

Gebruiker
Lid geworden
30 sep 2009
Berichten
720
Goedenavond allen,

Zit weer met een vraagje:

Is een vervolg op: 'In een UserForm / Image een picture invoeren'

Om een picture welke op dat moment voorkomt in een UserForm.Image te printen, gebruik ik het volgende:

Kopieer het originele picture (voor de helderheid v/h picture) naar een werkblad met enige gegevens daarboven.
Vervolgens print ik het geheel uit,
vervolgens verwijder ik alle gegevens van dat werkblad,

Als ik het bestand nu beëindigd en opsla, wordt het bestand enkele Mb groter.
Dit zijn de codes voor het kopieeren:
Code: 
  Application.ScreenUpdating = False                                ' tegen flikkeren van beeldscherm
  ActiveWorkbook.Worksheets("DBaseNotities").Activate                                                                   
  NaamPictureTB = NotitiesImage.Tag                                 ' zet picture naam neer
  ActiveWorkbook.Worksheets("DBaseNotities").Range("W61") = Split(NotitiesImage.Tag, "\")(UBound(Split(NotitiesImage.Tag, "\")))    ' zet Photonaam neer
  imagePath = TmpPath & NotitiesImage.Tag
  
  Dim img1 As OLEObject                 ' KOPIEERT EEN IMAGE VAN EEN USERFORM NAAR EEN WERKBLAD (2e optie)
  With Worksheets("DBaseNotities")
    Set img1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, _
        Left:=ActiveSheet.Cells(1, 21).Left, Top:=ActiveSheet.Cells(63, 1).Top, Width:=450, Height:=250)
    img1.Object.Picture = Me.NotitiesImage.Picture
  End With
  With img1
    .Object.PictureSizeMode = 1        'fmPictureSizeModeZoom
    .Object.Picture = Me.NotitiesImage.Picture
  End With
En dit de codes om het te verwijderen:
Code: 
  With Worksheets("DBaseNotities")
    .img1.Delete
  End With

De vraag is nu hoe kan ik voorkomen dat het program. de (waarschijnlijke grootte) v/h picture toch meeneemt in het bestand?
Het enigste wat me te binnen schiet is
Code: 
Dim img1 As OLEObject                 

Set img1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, _
        Left:=ActiveSheet.Cells(1, 21).Left, Top:=ActiveSheet.Cells(63, 1).Top, Width:=450, Height:=250)

dat deze variabele mee opgeslagen wordt in het bestand?
Hoe maak ik deze variabele leeg, zodat het bestandsgrootte hetzelfde blijft?

Iemand een idee hierover?

Many thanks already

Vr. Gr.

Dutch
 
Laatst bewerkt:
Ok, het volgende toegepast en schijnt te werken. (enige tijd testen)
Bij invoeren op wb:

Code: 
  Application.ScreenUpdating = False                                ' tegen flikkeren van beeldscherm
  ActiveWorkbook.Worksheets("DBaseNotities").Activate
  If NotitiesImage.Tag = "" Then NotitiesImage.Tag = NaamPictureTB  ' bij Basisis picture NotitiesImage = niets
  NaamPictureTB = NotitiesImage.Tag                                 ' zet picture naam neer
  ActiveWorkbook.Worksheets("DBaseNotities").Range("W61") = Split(NotitiesImage.Tag, "\")(UBound(Split(NotitiesImage.Tag, "\")))    ' zet Photonaam neer
  imagePath = TmpPath & NotitiesImage.Tag
  
  With Worksheets("DBaseNotities")
    Set img1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, _
        Left:=ActiveSheet.Cells(1, 21).Left, Top:=ActiveSheet.Cells(63, 1).Top, Width:=450, Height:=250)
    img1.Object.Picture = Me.NotitiesImage.Picture
  End With
  With img1
    .Object.PictureSizeMode = 1        'fmPictureSizeModeZoom
    .Object.Picture = Me.NotitiesImage.Picture
  End With

Bij printen en afsluiten:
Code: 
  With Worksheets("DBaseNotities")
    .Range("U55:AD108").Select:
    Selection.PrintOut copies:=1, Collate:=True             ' print 1 x het Document uit
    .Range("U56:AD56").Clear
    .Range("W57") = ""
    .Range("W59") = ""
    .Range("W61") = ""
  End With
  
  Set myImage = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
  myImage.Delete                                          ' verwijderd laatste ingevoerde picture (active)
  Set img1 = Nothing
  Set myImage = Nothing
    
  Sheets("DBaseNotities").Protect DrawingObjects:=True, contents:=True, Scenarios:=True ' beveilig blad weer
  Worksheets("DBaseNotities").Visible = 0
  Application.Goto [Behang!A1]                            ' gaat naar wb Behang cel A
  Application.ScreenUpdating = True                       ' tegen flikkeren van beeldscherm
 
Toch nog een probleempje tegengekomen.

Wanneer de gegevens en het picture over gekopieerd zijn, wordt het werkblad geprint.

Het fenomeen doet zich nu voor dat op het werkblad alles in kleur is, incluis het picture, maar wanneer het uitgeprint wordt alles in grijs geprint wordt.

Printer print normaal gewoon met kleur.

Nogmaals de code erbij:

Code: 
  Application.ScreenUpdating = False                                ' tegen flikkeren van beeldscherm
  ActiveWorkbook.Worksheets("DBaseNotities").Activate
  If NotitiesImage.Tag = "" Then NotitiesImage.Tag = NaamPictureTB  ' bij Basisis picture NotitiesImage = niets
  
  NaamPictureTB = NotitiesImage.Tag                                 ' zet picture naam neer
  ActiveWorkbook.Worksheets("DBaseNotities").Range("W61") = Split(NotitiesImage.Tag, "\")(UBound(Split(NotitiesImage.Tag, "\")))    ' zet Photonaam neer
  imagePath = TmpPath & NotitiesImage.Tag
  
  With Worksheets("DBaseNotities")
    Set img1 = ActiveSheet.OLEObjects.Add(ClassType:="Forms.Image.1", Link:=False, DisplayAsIcon:=False, _
        Left:=ActiveSheet.Cells(1, 21).Left, Top:=ActiveSheet.Cells(63, 1).Top, Width:=450, Height:=250)
    img1.Object.Picture = Me.NotitiesImage.Picture
  End With
  With img1
    .Object.PictureSizeMode = 1        'fmPictureSizeModeZoom
    .Object.Picture = Me.NotitiesImage.Picture
  End With

  With Worksheets("DBaseNotities")
    .Range("U55:AD108").Select:
    Selection.PrintOut copies:=1, Collate:=True             ' print 1 x het Document uit
    .Range("U56:AD56").Clear
    .Range("W57") = ""
    .Range("W59") = ""
    .Range("W61") = ""
  End With
  
  Set myImage = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
  myImage.Delete                                          ' verwijderd laatste ingevoerde picture (active)
  Set img1 = Nothing
  Set myImage = Nothing
    
  Sheets("DBaseNotities").Protect DrawingObjects:=True, contents:=True, Scenarios:=True ' beveilig blad weer
  Worksheets("DBaseNotities").Visible = 0
  Application.Goto [Behang!A1]                            ' gaat naar wb Behang cel A
  Application.ScreenUpdating = True                       ' tegen flikkeren van beeldscherm

Welke code stuurt nu m'n printer aan??

Iemand een idee?

Vr. Gr.

Dutch
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan