Question

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

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

我输入了以下代码，直到关于表100，然后由于被限制为32位Excel而我用完ram。有没有办法减少使用的内存量？

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这是一个例子

使用以下代码，在用完ram

之前，我会看到第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不是为了处理这种规模的图像处理，尽管保存，关闭和放大在整个过程中重新开放将释放一些记忆。

以这种方式进行批量照片编辑有许多免费选项（在线或可下载），例如ImBatch或BatchPhoto，它们可以立即完成工作。

请注意，PictureEffects基本上是在每次操作时保存一个新的“图层”，随之吸收内存。（就我而言，每次更改大约2000kb。）

如果您选择坚持使用Excel，请使用ShapeRange.PictureFormat Property代替PictureEffects Object。

此外，如果您正在使用API，请注意Stack Overflow为您提供了标签！ google-static-maps如果您在问题中添加该标记，那么您可能会从比我更熟悉该API的人那里得到进一步的帮助。

查看此链接（请注意可直接在网址中处理的调整项）：

<子> 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）

尝试类似：

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

...

我没有对此进行测试，但有例here和here

操作图像Excel VBA时减少内存

1 个答案: