是否有 VBA 代码（对于 Access 2016）来创建空白/任何 PNG 文件

Question

遗憾的是我没有代码可以分享，但这是一个简单的问题。我正在寻找一段代码，它将创建一些具有特定名称（ QR_[ID].png ）的 png 文件（可以是空白的，彩色的，等等）。

在我的例子中，它是存储使用 Print DownloadHTTP( URL, DestinationPath )

获得的二维码

url 是：“https://qrickit.com/qrickit_apps/qrickit_api.php” 将生成二维码

DownloadHTTP 将只访问具有特定 ID 的 url 并下载图像，然后将 DestinationPath 中的现有文件更改为下载的 QR 码图像

该代码适用于已创建的 PNG，因此 png 文件的创建是唯一缺少的部分。但是我找不到创建一些 png 文件的方法，而且 google 今天对我不友好 :(.

最糟糕的是我不是 windows 的管理员，所以几乎什么都做不了。

感谢大家的帮助！

Answer 1

要转换、调整大小、翻转、旋转、合并甚至创建图像，请使用 WIA-Libary

可以在 devhut.net

找到一些示例

Public Sub CreateBlankPngImage()

Dim PathToCreatedImage As String
PathToCreatedImage = "" ' insert path and filename here

Dim sFormatID As String
sFormatID = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}" 'https://docs.microsoft.com/en-us/previous-versions/windows/desktop/wiaaut/-wiaaut-consts-formatid

Dim sExt As String
sExt = "PNG"

Dim oWIA As Object    'WIA.ImageFile    
Set oWIA = CreateObject("WIA.ImageFile")

Dim v As Object ' Wia.Vector
Set v = CreateObject("WIA.Vector")

v.Add &HFFFFFFFF 'White (A=255,R=255,G=255,B=255)

Set oWIA = v.ImageFile(1, 1) ' create image with size 1x1

With CreateObject("WIA.ImageProcess")
    .Filters.Add .FilterInfos("Scale").FilterID
    .Filters(1).Properties("MaximumWidth") = 200 'Width
    .Filters(1).Properties("MaximumHeight") = 200 'Height

    .Filters.Add .FilterInfos("Convert").FilterID
    .Filters(2).Properties("FormatID") = sFormatID 'convert to PNG
    .Filters(2).Properties("Quality") = 100

    Set oWIA = .Apply(oWIA) 'process image
End With

oWIA.SaveFile PathToCreatedImage

Set v = Nothing
Set oWIA = Nothing
End Sub

当然，对于您的目的，复制默认的 PNG 文件就足够了-

Answer 2

已接受的答案适用于创建白色图像，但不适用于任何其他颜色。这是使用 &HFF2D7D9A&（冷蓝色）的结果：

WIA Scale 过滤器中似乎存在错误。我进行了广泛的测试，发现无论图像类型（bmp、png、jpg）如何，都会出现此问题。外观会有所不同，但不会是纯色（检查图像的右下角）。源是向量（如此代码的情况）还是使用外部程序（如 MSPaint）创建的文件都无关紧要。它是 VBA 还是 VBS 脚本也没关系，我希望使用任何其他语言都能得到相同的结果。

为了解决该错误，我不得不将起始图像放大（经过大量反复试验后我确定 20x20 作为可靠尺寸），将目标图像填充为比所需尺寸至少大 6最长尺寸的百分比（为了安全起见，我选择了 10%），最后在以所需格式保存之前裁剪额外的填充像素。

明显的问题：为什么不直接创建所需大小的矢量，而不是使用“缩放”过滤器？回答：那样做（对于全屏尺寸的图像）需要很长时间，因为你必须为每个像素做一个 .Add。

这是添加了解决方法的代码：

Public Sub CreateBlankPngImage()

PathToCreatedImage = "" ' insert path and filename here

wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
ARGB = &HFF2D7D9A& 'Cool blue
ImageWidth = 1920
ImageHeight = 1080
Pad = Int(0.1 * ImageWidth)

Set oWIA = CreateObject("WIA.ImageFile")
Set v = CreateObject("WIA.Vector")

For i = 1 To 400
    v.Add ARGB
Next

Set oWIA = v.ImageFile(20, 20)

With CreateObject("WIA.ImageProcess")
    .Filters.Add .FilterInfos("Scale").FilterID
    .Filters(1).Properties("MaximumWidth") = ImageWidth + Pad
    .Filters(1).Properties("MaximumHeight") = ImageHeight + Pad
    .Filters(1).Properties("PreserveAspectRatio") = KeepAspect
    .Filters.Add .FilterInfos("Crop").FilterID
    .Filters(2).Properties("Right") = Pad
    .Filters(2).Properties("Bottom") = Pad
    .Filters.Add .FilterInfos("Convert").FilterID
    .Filters(3).Properties("FormatID") = wiaFormatPNG
    Set oWIA = .Apply(oWIA)
End With

oWIA.SaveFile PathToCreatedImage

End Sub

Answer 3

我使用 Microsoft Office Power Point 对象模型找到了一个很棒的解决方案。创建空白 PNG 图像文件的基本算法是这样的：

实例化 PowerPoint.Application 对象。
创建一个不可见的演示文稿window。
在演示文稿中创建空白幻灯片。
在幻灯片中创建一个矩形。
删除矩形的轮廓。
将形状的填充颜色设置为白色或任何所需的颜色。
以 PNG 格式导出形状。
进行清理。

就是这样！查看代码并阅读代码中的注释，了解如何更改创建的图像的尺寸、更改其背景颜色等。

Sub CreateBlankPngImage()
    Dim pngPath As String
    pngPath = "" ' insert path and filename here
    Dim width As Single
    Dim height As Single
    ' The dimensions of the PNG image
    width = 200
    height = 200
    ' The background color of the PNG image is defined below.
    ' The color is in the format bbggrr, where bb, gg and rr
    ' are hexadecimal numbers ranging from 1 to 255 and
    ' specify the components of the color.
    Dim bgColor As String
    bgColor = "ffffff"

    Dim oPP, oPresentation, oSlide, oShape
    
    Set oPP = CreateObject("PowerPoint.Application")
    Set oPresentation = oPP.Presentations.Add(0)
    
    Const ppLayoutBlank = 12
    Set oSlide = oPresentation.Slides.Add(1, ppLayoutBlank)
    
    Const msoShapeRectangle = 1
    Set oShape = oSlide.Shapes.AddShape(msoShapeRectangle, 0, 0, width, height)
    
    oShape.Line.Visible = 0
    
    ' Uncomment the following line if you want your PNG
    ' to be completely transparent!
    'oShape.Fill.Visible = 0
    
    oShape.Fill.ForeColor.RGB = CLng("&h" & bgColor)
    
    Const ppShapeFormatPNG = 2
    oShape.Export pngPath, ppShapeFormatPNG
    
    oPP.Quit
    Set oPP = Nothing
    Set oPresentation = Nothing
    Set oSlide = Nothing
    Set oShape = Nothing
End Sub

您还可以将其他常量而不是 ppShapeFormatPNG 传递给 Export 方法，以便以其他格式存储空白图像。如果这样做，请务必同时更改第一个参数中的文件扩展名。下面列出了这些常量及其数值：

ppShapeFormatBMP = 3 将图像导出为位图 (.bmp)
ppShapeFormatEMF = 5 将图像导出为增强的 Windows 图元文件 (.emf)
ppShapeFormatGIF = 0 将图像导出为图形交换格式 (.gif)
ppShapeFormatJPG = 1 将图像导出为 .jpg
ppShapeFormatPNG = 2 将图像导出为便携式网络图形 (.png)
ppShapeFormatWMF = 4 将图像导出为 Windows 图元文件 (.wmf)

附带说明一下，我只是想知道为什么这些常量中缺少 TIFF（标签图像文件）格式！相当奇怪的是，Microsoft Power Point 绝对能够 以 TIFF 格式导出形状，因为当您 right-click 在一个形状上时，它在“保存类型”列表中有这个选项并且select“另存为图片...”！

是否有 VBA 代码（对于 Access 2016）来创建空白/任何 PNG 文件

Is there a VBA code ( for Access 2016) to create a blank / any PNG file

ms-access

png

qr-code