图片是链接形式的怎么批量保存？

Emily33

需求：文件夹名称为‘1’里面有日志图片9张


求各位大神赐教~~感谢...

quqiyuan

参与一下，仅供参考。。。

文件夹如果存在，就不管，没有就创建，根据第二列名称

图片名称第三列加序号001.。。

quqiyuan

代码如下。。。。
Sub test()
    Application.ScreenUpdating = False
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("广西嘉利工作日志")
    p = ThisWorkbook.Path & "\"
    arr = sht.[a1].CurrentRegion
    For i = 2 To UBound(arr)
        n = 0
        ss = arr(i, 2)
        sss = arr(i, 3)
        f = Dir(p & ss, vbDirectory)
        If f = "" Then MkDir p & ss
        s = Split(arr(i, 4), Chr(10))
        For j = 0 To UBound(s)
        If s(j) <> "" Then
            n = n + 1
            Set pic = Sheet1.Pictures.Insert(s(j))
            With pic
                .CopyPicture
                w = .Width
                h = .Height
                With ActiveSheet.ChartObjects.Add(0, 0, w, h).Chart
                    .Parent.Select
                    .Paste
                    .Export p & ss & "\" & sss & Format(n, "000") & ".jpg"
                    .Parent.Delete
                End With
                .Delete
            End With
        End If
        Next
    Next
    Application.ScreenUpdating = True
    Beep
End Sub

Emily33

quqiyuan 发表于 2024-11-17 19:48
参与一下，仅供参考。。。

文件夹如果存在，就不管，没有就创建，根据第二列名称

没有文件夹....因为有几百条数据，手动创建很慢，有没有创建文件夹的教程
另外，上面的代码可以复制给我吗，谢谢

quqiyuan

Emily33 发表于 2024-11-17 19:57
没有文件夹....因为有几百条数据，手动创建很慢，有没有创建文件夹的教程
另外，上面的代码可以复制给我 ...

我这个写了啊，如果文件夹不存在会创建的，你下载我的附件，里面测试一下就知道了呀
创建新文件夹会在此文件的文件夹下，你测试一下就明白啦

zpy2

select colIndex[0:1],replace(replace(日志图片,'https','<img src=https'),'.jpg','.jpg >') 图片 from 广西嘉利工作日志;

Emily33

zpy2 发表于 2024-11-18 12:42
select colIndex[0:1],replace(replace(日志图片,'https','') 图片 from 广西嘉利工作日志;

说缺少CASE 等你有空时能不能发个附件给我，麻烦大神了~~

zpy2

Emily33 发表于 2024-11-19 14:57
说缺少CASE 等你有空时能不能发个附件给我，麻烦大神了~~

这个是在线工具生成的网页，可以保存到.mht或.html文件。

zpy2

这个是下载文件。