Sub 按鈕_Click()
Dim nowmonth As String
nowmonth = "12"
Dim mybook As Workbook
Set mybook = Workbooks.Open(ThisWorkbook.Path & "\2020年" & nowmonth & "月份(1).xls")
Dim target As Workbook
Set target = Workbooks.Open(ThisWorkbook.Path & "\結果.xlsx")
Dim picnum As Integer
'Set mybook = Workbooks(ThisWorkbook.Path & "\2020年2月份(1).xlsx")
For j = 1 To 30 '行數
'Sheets("sheet1").Range(j).Copy ThisWorkbook.Sheets("sheet3").Range(j)
'Call 復制行(j)
picnum = 0
mybook.Sheets("sheet1").Rows(j).Copy mybook.Sheets("sheet2").Rows(j)
For i = 1 To mybook.Sheets("sheet2").Shapes.Count
picnum = picnum + 1
Set s = mybook.Sheets("sheet2").Shapes(i)
picRow = s.TopLeftCell.Row
sku = mybook.Sheets("sheet2").Cells(picRow, 1)
s.Width = s.Width * 2
s.Height = s.Height * 2
If sku <> "" Then
s.Copy
Set c = mybook.Sheets("sheet2").ChartObjects.Add(0, 0, s.Width, s.Height)
c.Activate
c.Chart.Paste
c.Chart.Export "D:\cs\2020_" & nowmonth & "_" & sku & ".jpg" '在D盤,新建檔案夾（CS）
c.Delete
End If
Next i
mybook.Sheets("sheet1").Cells(j, 21).Value = picnum
Dim Shp As Shape
For Each Shp In mybook.Sheets("sheet2").Shapes
Shp.Delete
Next
mybook.Sheets("sheet2").Range("2:65536").Clear
Next j
mybook.Close
target.Close
Set mybook = Nothing
Set target = Nothing
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/247827.html