Speicher bei der Bearbeitung von Bildern zu reduzieren Excel VBA

Question

Ich habe eine Excel-Tabelle, die Satellitenbilder für Helikopterlandeplätze herunterlädt und sie in Registerkarten mit dem Standortcode platziert. Es gibt 166, um genau zu sein, jeder von denen hat 2 statische Kartenbilder für insgesamt 332 Bilder und ich muss sie auf verschiedene Arten manipulieren.

Ich habe kein Problem, sie herunterzuladen und zu platzieren, aber wenn ich sie manipuliere, habe ich keinen Speicher mehr. Die Manipulationen sollen unseren Piloten helfen, nachts besser zu sehen, wenn sie auf die Karten schauen, da sie auf einem Bildschirm angezeigt werden.

Ich tippte den folgenden Code und es funktioniert bis etwa Blatt 100 und dann habe ich aus RAM aufgrund der Beschränkung auf eine 32-Bit-Excel. Gibt es eine Möglichkeit, die Menge an Speicher zu reduzieren?

Public Sub SwitchtoNight() 
    Dim oWS As Worksheet 
    For i = 5 To ThisWorkbook.Sheets.Count 
     Set oWS = ThisWorkbook.Sheets(i) 
     With oWS 
      .Shapes("GoogleMap1").Fill.PictureEffects.Insert(msoEffectSaturation).EffectParameters(1).Value = 0 'Saturation 
      .Shapes("GoogleMap1").Fill.PictureEffects.Insert(msoEffectBrightnessContrast).EffectParameters(1).Value = -0.35 'Brightness 
      .Shapes("GoogleMap1").Fill.PictureEffects.Insert(msoEffectBrightnessContrast).EffectParameters(2).Value = 0.75 'Contrast 

      .Shapes("GoogleMap2").Fill.PictureEffects.Insert(msoEffectSaturation).EffectParameters(1).Value = 0 'Saturation 
      .Shapes("GoogleMap2").Fill.PictureEffects.Insert(msoEffectBrightnessContrast).EffectParameters(2).Value = 0.35 'Contrast 
     End With 
     Set oWS = Nothing 
    Next i 
End Sub 

Die Bilder sind über 400px X 400px hier ein Beispiel

Mit dem folgenden Code ist ich Blatt bekommen 140, bevor ich aus dem RAM laufen

Public Sub SwitchtoNight() 
    Application.ScreenUpdating = False 
    Application.Calculation = xlCalculationManual 
    Application.EnableEvents = False 

    Dim oWS As Worksheet 
    For i = 5 To ThisWorkbook.Sheets.Count 
     Set oWS = ThisWorkbook.Sheets(i) 
     oWS.DisplayPageBreaks = False 
     With oWS 
      .Shapes("GoogleMap1").Fill.PictureEffects.Insert(msoEffectSaturation).EffectParameters(1).Value = 0: .Shapes("GoogleMap1").Fill.PictureEffects.Insert(msoEffectBrightnessContrast).EffectParameters(1).Value = -0.35: .Shapes("GoogleMap1").Fill.PictureEffects.Insert(msoEffectBrightnessContrast).EffectParameters(2).Value = 0.75 
      .Shapes("GoogleMap2").Fill.PictureEffects.Insert(msoEffectSaturation).EffectParameters(1).Value = 0: .Shapes("GoogleMap2").Fill.PictureEffects.Insert(msoEffectBrightnessContrast).EffectParameters(2).Value = 0.35 
     End With 
     Set oWS = Nothing 
    Next I 

    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 
End Sub 

Answer 1

Herunterladen der Bilder als eine Nachtkarte hilft, ebenso wie das Speichern von JPG anstelle von PNG. Ich denke, Excel ist nicht nur dazu gedacht, Bildmanipulationen in diesem Maßstab zu handhaben, obwohl das Speichern, das Schließen von & Re-Opening während des Prozesses wird einige Speicher freigeben.

Es gibt eine Reihe von kostenlosen Optionen (online oder herunterladbar) für Batch-Fotobearbeitung auf diese Weise, wie ImBatch oder BatchPhoto, die den Job in kürzester Zeit erledigen werden.

Beachten Sie, dass PictureEffects grundsätzlich eine neue "Ebene" bei jeder Manipulation speichert und dabei Speicher mit sich bringt. (In meinem Fall ungefähr 2000kb pro Änderung.)

Wenn Sie sich entscheiden, mit Excel zu bleiben, verwenden Sie die ShapeRange.PictureFormat Property anstelle der PictureEffects Object.

---

Auch wenn Sie die API verwenden, beachten Sie, dass Stack-Überlauf einen Tag nur für Dich hat! google-static-maps Wenn Sie dieses Tag zu Ihrer Frage hinzufügen, erhalten Sie möglicherweise weitere Hilfe von Personen, die mit dieser API besser vertraut sind als ich.

Schauen Sie sich diesen Link (die Anpassungen beachten Sie als direkt in der URL bearbeitet werden können):

_{http://maps.googleapis.com/maps/api/staticmap?key=AIzaSyADV4Wfi9-4ET5GG52Cw_l0_Bkt8W5vwvM&center=43.597586,-79.746689&zoom=14&markers=icon:http://www.xmeasures.com/images/planMapPin.png|43.597586,-79.746689&format=png32&sensor=false&size=480x480&scale=4&markers=color:black|&maptype=roadmap&style=feature|element:geometry|hue:0xwhite|saturation:-100%|lightness:100|visibility:off&style=feature:road|element:geometry|hue:0xblack|saturation:-100%|lightness:-20|visibility:on&style=feature:road.path|element:labels|hue:0xblack|saturation:-100%|lightness:-20|visibility:off&style=feature:labels|element:geometry|hue:0xblack|saturation:-100%|lightness:-20|visibility:off&style=feature:water|element:geometry|hue:0xblack|saturation:-100%|lightness:-40|visibility:on&style=element:labels.text.stroke|visibility:off&style=element:labels.text.fill|visibility:off&style=feature:road|hue:0xblack|saturation:-100%|lightness:-100|element:labels.text.fill|visibility:on&style=feature:transit|visibility:off&style=feature:poi|visibility:off&style=feature:landscape|visibility:off&key=AIzaSyADV4Wfi9-4ET5GG52Cw_l0_Bkt8W5vwvM|} (Source)

---

Probieren Sie etwas wie:

Dim oWS As Worksheet, sh As Shape 

...

Set oWS = ThisWorkbook.Sheets(I) 
    Set sh = oWS.Shapes("GoogleMap1") 
    With sh 
     .PictureFormat.Brightness = -0.35 
     .PictureFormat.Contrast = 0.75 

     With sh.Fill.PictureEffects 
      .Delete (1) 
      .Insert(msoEffectSaturation).EffectParameters(1).Value = 0 
     End With 
    End With 
    Set sh = Nothing 
    Set oWS = Nothing 

...

ich dies nicht getestet, aber es gibt Beispiele here und here