Office中国论坛/Access中国论坛

标题: [源码共享]导出Access图片控件的图片到文件 [打印本页]

作者: tmtony    时间: 2013-11-13 15:39
标题: [源码共享]导出Access图片控件的图片到文件
Image图片控件可指定图片路径,但设置后,如果源文件删除,就无法将这个图片导出来,这个源码可将图片再导出来

一. 导出到PNG文件格式

Public Function savePict(pImage As Access.Image)
    Dim fname As String 'The name of the file to save the picture to
    fname = Environ("Temp") + "\temp.png" ' Destination file path

    Dim iFileNum As Double
    iFileNum = FreeFile 'The next free file from the file system

    Dim pngImage As String 'Stores the image data as a string
    pngImage = StrConv(pImage.PictureData, vbUnicode) 'Convert the byte array to a string

    'Writes the string to the file
    Open fname For Binary Access Write As iFileNum
        Put #iFileNum, , pngImage
    Close #iFileNum
End Function

二.导出到 EMF文件格式
Public Function savePict(pImage As Access.Image)
    Dim fname As String 'The name of the file to save the picture to
    Dim iFileNum As Double
    Dim bArray() As Byte, cArray() As Byte
    Dim lngRet As Long

    fname = Environ("Temp") + "\temp.emf" ' Destination file path
    iFileNum = FreeFile 'The next free file from the file system

    ' Resize to hold entire PictureData prop
    ReDim bArray(LenB(pImage.PictureData) - 1)
    ' Resize to hold the EMF wrapped in the PictureData prop
    ReDim cArray(LenB(pImage.PictureData) - (1 + 8))
    ' Copy to our array
    bArray = pImage.PictureData
    For lngRet = 8 To UBound(cArray)
        cArray(lngRet - 8) = bArray(lngRet)
    Next

    Open fname For Binary Access Write As iFileNum
    'Write the byte array to the file
    Put #iFileNum, , cArray
    Close #iFileNum
End Function


作者: zhuyiwen    时间: 2013-11-13 15:50
谢谢分享
作者: tmtony    时间: 2013-11-13 17:35
谢谢 淘贴 收藏
作者: 馨语馨愿    时间: 2014-4-28 21:57
谢谢楼主分享
作者: cjhahang    时间: 2014-5-13 22:33
好好学习,天天向上
作者: sxb2007    时间: 2014-7-3 07:43
好好学习,天天向上
作者: p51219    时间: 2016-7-10 00:41
好好好呵呵呵呵呵
作者: p51219    时间: 2016-7-10 00:42
好好好呵呵呵呵呵
作者: 李力军2    时间: 2016-8-3 17:28
学习提高
作者: 使者    时间: 2016-8-23 15:20
谢谢分享
作者: 李力军2    时间: 2016-9-1 11:42
好贴!
作者: wuwu20022    时间: 2019-2-25 15:02
学习
作者: wuwu200222    时间: 2020-4-22 11:25
学习
作者: wuwu200222    时间: 2020-11-19 15:14
学习




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3