导出图片为JPG板式代码出借

sdgyc

Book4.zip (415.95 KB, 下载次数: 9)

2018-9-3 09:25 上传

点击文件名下载附件
附件

请求老师帮忙：导出代码出错，
Dim strPath$, nm$, sh As Shape
    Dim ch As Chart, i&
    Dim cht As ChartObject
    Application.ScreenUpdating = False
    strPath = ThisWorkbook.Path & "\"
    For i = 1 To ActiveSheet.Shapes.Count
        Set sh = ActiveSheet.Shapes(i)
        nm = Range(sh.TopLeftCell.Address).Offset(0, -1).Value
        If nm = "" Then GoTo 100
        sh.CopyPicture
        Set cht = ActiveSheet.ChartObjects.Add(100, 100, 200, 200)
        With cht
            .Chart.Paste
            .Chart.Shapes(1).Height = 200
            .Chart.Shapes(1).Width = 200
            .Chart.Export strPath & nm & ".jpg"
            .Delete
        End With
100:
    Next
    Application.ScreenUpdating = True

ykqrs

是不是名字有什么非法字符？你改一下试试

sdgyc

ykqrs 发表于 2018-9-3 10:48
是不是名字有什么非法字符？你改一下试试

老师你好，刚试了都一样

sdgyc

ykqrs 发表于 2018-9-3 10:48
是不是名字有什么非法字符？你改一下试试

能忽略非法字符吗？图片太多很难找出非法字符。多谢！！！

ykqrs

1. Sub lqxs()
   
2. Dim strPath$, nm$, sh As Shape, x%
   
3.     Dim ch As Chart, i&
   
4.     Dim cht As ChartObject
   
5.     Application.ScreenUpdating = False
   
6.     strPath = ThisWorkbook.Path & ""
   
7.     For Each sh In ActiveSheet.Shapes
   
8.         If sh.Type = 13 Then
   
9.         nm = Range(sh.TopLeftCell.Address).Offset(0, -1).Value
   
10.         If nm = "" Then GoTo 100
    
11.         sh.CopyPicture
    
12.         Set cht = ActiveSheet.ChartObjects.Add(100, 100, 200, 200)
    
13.         With cht
    
14.             .Chart.Paste
    
15.             .Chart.Shapes(1).Height = 200
    
16.             .Chart.Shapes(1).Width = 200
    
17.             .Chart.Export strPath & nm & ".jpg"
    
18.             .Chart.Parent.Delete
    
19.         End With
    
20. 100:
    
21. End If
    
22.     Next
    
23.     Application.ScreenUpdating = True
    
24. End Sub
    

复制代码

ykqrs

不知为什么？回复又要审核，真郁闷 新建文件夹.rar (634.79 KB, 下载次数: 8)

2018-9-3 11:06 上传

点击文件名下载附件

ykqrs

sdgyc 发表于 2018-9-3 11:02
能忽略非法字符吗？图片太多很难找出非法字符。多谢！！！

应该是那个引号的问题，你搜索一下看看，文件名应该有些特殊字符不可以有

ykqrs

sdgyc 发表于 2018-9-3 11:02
能忽略非法字符吗？图片太多很难找出非法字符。多谢！！！

用正则替换一下
.Pattern = "[<>/\\|:""*?]+"

sdgyc

ykqrs 发表于 2018-9-3 11:13
应该是那个引号的问题，你搜索一下看看，文件名应该有些特殊字符不可以有

全部引号清除也是这样

ykqrs

sdgyc 发表于 2018-9-3 11:47
全部引号清除也是这样

我的附件有问题？你看了没有？