
生成的图片在这➡
这是用来测试的数据,测试图片在D2的单元格里,我想创建文件夹后把D2列的图片存进去,图片是生成成功了,但是并不是D2列的,而且小的有点夸张,求教各位怎么才能按照原本的尺寸生成出来啊
Sub SaveColumn4AsImageToUserFolder()
Dim lastRow As Long
Dim county As String
Dim town As String
Dim user As String
Dim contentCell As Range
Dim ws As Worksheet
Set ws = Sheet1
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For i = 2 To lastRow
county = ws.Cells(i, 1).Value
town = ws.Cells(i, 2).Value
user = ws.Cells(i, 3).Value
Set contentCell = ws.Cells(i, 4)
If county <> "" And town <> "" And user <> "" Then
'检查县区文件夹是否存在,如果不存在则创建
If Not Dir("E:\" & county, vbDirectory) = "" Then
MsgBox "县区文件夹 " & county & " 已存在。"
Else
MkDir "E:\" & county
End If
'检查乡镇文件夹是否存在,如果不存在则创建
If Not Dir("E:\" & county & "\" & town, vbDirectory) = "" Then
MsgBox "乡镇文件夹 " & town & " 在县区 " & county & " 下已存在。"
Else
MkDir "E:\" & county & "\" & town
End If
'检查用户文件夹是否存在,如果不存在则创建
If Not Dir("E:\" & county & "\" & town & "\" & user, vbDirectory) = "" Then
MsgBox "用户文件夹 " & user & " 在乡镇 " & town & "、县区 " & county & " 下已存在。"
Else
MkDir "E:\" & county & "\" & town & "\" & user
End If
'将第四列内容作为图片保存
Dim tempFileName As String
tempFileName = "contentImage2.png"
contentCell.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With ActiveSheet.ChartObjects.Add(0, 0, 1, 1).Chart
.Paste
.Export "E:\" & county & "\" & town & "\" & user & "\" & tempFileName
End With
End If
Next i
End Sub

七奈