[已解决]如何用VBA操作复制指定图片的数量？谢谢

新一

如何用VBA操作复制指定图片的数量？谢谢，如附件。

最佳答案

月排行榜 / 总排行榜

爱疯

2016-5-19 22:01

'复制后，新文件名格式是：原文件名_次数.jpg
Sub copyPic()
    Dim fso
    Dim picPath$, copyPath$, oldFile$, newFile$
    Dim A, i%, j%

    Set fso = CreateObject("scripting.filesystemobject")
    picPath = ThisWorkbook.Path & "\图片" '手动指定
    copyPath = ThisWorkbook.Path & "\复制" '手动指定

    If fso.FolderExists(copyPath) Then fso.DeleteFolder copyPath
    fso.createfolder copyPath

    A = Range("a1").CurrentRegion
    For i = 1 To UBound(A)
        For j = 1 To A(i, 2)
            oldFile = picPath & "\" & A(i, 1) & ".jpg"
            newFile = copyPath & "\" & A(i, 1) & "_" & j & ".jpg"
            fso.copyFile oldFile, newFile
        Next j
    Next i
End Sub

复制图片.rar (127.34 KB, 下载次数: 18)

2016-5-19 22:01 上传

点击文件名下载附件

跳转到最佳答案楼层

爱疯

'复制后，新文件名格式是：原文件名_次数.jpg
Sub copyPic()
    Dim fso
    Dim picPath$, copyPath$, oldFile$, newFile$
    Dim A, i%, j%

    Set fso = CreateObject("scripting.filesystemobject")
    picPath = ThisWorkbook.Path & "\图片" '手动指定
    copyPath = ThisWorkbook.Path & "\复制" '手动指定

    If fso.FolderExists(copyPath) Then fso.DeleteFolder copyPath
    fso.createfolder copyPath

    A = Range("a1").CurrentRegion
    For i = 1 To UBound(A)
        For j = 1 To A(i, 2)
            oldFile = picPath & "\" & A(i, 1) & ".jpg"
            newFile = copyPath & "\" & A(i, 1) & "_" & j & ".jpg"
            fso.copyFile oldFile, newFile
        Next j
    Next i
End Sub

复制图片.rar (127.34 KB, 下载次数: 18)

2016-5-19 22:01 上传

点击文件名下载附件

新一

谢谢{:011:}