操作图像时减less内存Excel VBA

我有一个Excel工作表，用于下载直升机着陆点的卫星图像，并将它们放入带有站点代码的选项卡中。 有166是准确的每个人有2静态地图图像总共332图像，我需要通过几种方式来操纵它们。

我没有问题下载并放置它们，但是当我操纵它们时，内存不足。 操作是为了帮助我们的飞行员在晚上看地图时看到更好，因为它们显示在屏幕上。

我input了下面的代码，它工作，直到关于工作表100，然后由于被限制在一个32位的Excel，我用尽了内存。 有没有办法减less正在使用的内存量？

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 

图像大约400px x 400px这里是一个例子

用下面的代码，我得到表140之前，我的内存不足

 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

将图像作为夜间地图下载将有所帮助，保存为JPG而不是PNG。 我认为Excel并不是要处理这种规模的image processing，虽然在整个过程中保存，closures和重新打开将释放一些内存。

以这种方式批量照片编辑有许多免费的选项（在线或可下载的），比如ImBatch或BatchPhoto ，它们将很快完成这项工作。

请注意，PictureEffects基本上是每个操作都保存一个新的“图层”，随着它的吸引记忆。 （在我的情况下，每个更改大约2000kb）

如果您select坚持使用Excel，请使用ShapeRange.PictureFormat属性而不是PictureEffects对象 。

---

另外，如果您使用的是API，请注意Stack Overflow 仅为您提供了一个标签！ google-static-maps如果你添加标签到你的问题，你可能会从更熟悉API的人那里得到进一步的帮助。

看看这个链接（注意调整可以直接在URL中处理）：

_{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＆格式= PNG32＆传感器=假大小=小480×480＆规模= 4＆标记=颜色：黑|＆地图types=路标＆风格=特征|元件：几何|色调：0xwhite |饱和度：-100％|亮度：100 |能见度：closures＆风格=特征：道路|元件：几何|色调：0xblack |饱和度：-100％|亮度：-20 |能见度：上式＆=特征：road.path |元件：标签|色调：0xblack |饱和度：-100％|亮度：-20 |能见度：closures＆风格=特征：标签|元件：几何|色调：0xblack |饱和度：-100％|亮度：-20 |能见度：closures＆风格=特征：水|元件：几何|色调：0xblack |饱和度：-100％|亮度：-40 |知名度：在＆风格=元素：labels.text.stroke |可见性：closures与风格=元素：labels.text.fill |可见性：closures与风格=function：道路|色调：0xblack |饱和度：100％|亮度：-100 |元素：标签.text.fill |可见：上＆风格=特点：交通|可见性：closures与风格= F eature：POI |可见性：closures与风格=特征：景观|可见性：closures和钥匙= AIzaSyADV4Wfi9-4ET5GG52Cw_l0_Bkt8W5vwvM |} （ 来源 ）

---

尝试像这样：

  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 

…

我没有testing这个，但在这里和这里有例子