Xuất VÙNG DỮ LIỆU trong sheet excel sang file HÌNH ẢNH

[Tuấn Bụng Bự]

Xin chào các bác !
Lại là em Gà mờ VBA lên làm phiền các bác mong được góp ý kiến.
Em có mày mò với ChatGPT ra được đoạn code VBA xuất 1 vùng dữ liệu trong sheet excel sang 1 file ảnh png
Khi em debug từng dòng tìm lỗi thì nó không vấn đề gì xuất hình ảnh rất OK
Nhưng khi em cho nó chạy auto thì có hình xuất được có hình chỉ có 1 màu trắng
( em có thử với việc thêm wait nhưng chưa khắc phục được triệt để mà nó chậm thôi rồi)

Mô tả ý tưởng : lấy dữ liệu từ sheet data cho sang sheet phiếu
xuất vùng dữ liệu từ sheet phiếu bằng cách copy picture paste vào 1 biểu đồ rồi xuất ra định dạng png

Option Explicit


Sub XUATPHIEU_PNG()


Dim lr&, i&, j&
Dim ar
Dim vungDULieu As Range
Dim bieuDo As Object
Dim duongDan As String


duongDan = ThisWorkbook.Path


'Lay vung du lieu xuat phieu
With sdata
   lr = .Cells(.Rows.Count, "B").End(xlUp).Row
   If lr < 3 Then Exit Sub
   ar = .Range("B3:K" & lr).Value
End With


'ghi du lieu va xuat phieu png
With sphieu
   For i = 1 To UBound(ar, 1)
      'ghi du lieu
      For j = 1 To UBound(ar, 2)
         .Cells(j + 1, 3) = ar(i, j)
      Next j
      
      'Xuat phieu
      Set vungDULieu = .Range("A1:D12")
      'Tao 1 bieu do trong ( khong co noi dung) công 1000 de no khong che hinh anh lúc copy picture
      Set bieuDo = .ChartObjects.Add(Left:=vungDULieu.Left + 500, Width:=vungDULieu.Width, _
                  Top:=vungDULieu.Top, Height:=vungDULieu.Height)
      'Copy du lieu dang hinh anh
      vungDULieu.CopyPicture Appearance:=xlScreen, Format:=xlPicture
      'Dan du lieu vao bieu do
      bieuDo.Chart.Paste
      'Xuat du lieu bieu do ra dang hinh anh
      bieuDo.Chart.Export duongDan & "\" & ar(i, 1) & ".png", "PNG"
      'Xoa bieu do trong sheet
      bieuDo.Delete


   Next i
End With




End Sub

 

[tranchautrungduong]

Xin chào các bác !
Lại là em Gà mờ VBA lên làm phiền các bác mong được góp ý kiến.
Em có mày mò với ChatGPT ra được đoạn code VBA xuất 1 vùng dữ liệu trong sheet excel sang 1 file ảnh png
Khi em debug từng dòng tìm lỗi thì nó không vấn đề gì xuất hình ảnh rất OK
Nhưng khi em cho nó chạy auto thì có hình xuất được có hình chỉ có 1 màu trắng
( em có thử với việc thêm wait nhưng chưa khắc phục được triệt để mà nó chậm thôi rồi)

Mô tả ý tưởng : lấy dữ liệu từ sheet data cho sang sheet phiếu
xuất vùng dữ liệu từ sheet phiếu bằng cách copy picture paste vào 1 biểu đồ rồi xuất ra định dạng png

Option Explicit


Sub XUATPHIEU_PNG()


Dim lr&, i&, j&
Dim ar
Dim vungDULieu As Range
Dim bieuDo As Object
Dim duongDan As String


duongDan = ThisWorkbook.Path


'Lay vung du lieu xuat phieu
With sdata
   lr = .Cells(.Rows.Count, "B").End(xlUp).Row
   If lr < 3 Then Exit Sub
   ar = .Range("B3:K" & lr).Value
End With


'ghi du lieu va xuat phieu png
With sphieu
   For i = 1 To UBound(ar, 1)
      'ghi du lieu
      For j = 1 To UBound(ar, 2)
         .Cells(j + 1, 3) = ar(i, j)
      Next j
      
      'Xuat phieu
      Set vungDULieu = .Range("A1:D12")
      'Tao 1 bieu do trong ( khong co noi dung) công 1000 de no khong che hinh anh lúc copy picture
      Set bieuDo = .ChartObjects.Add(Left:=vungDULieu.Left + 500, Width:=vungDULieu.Width, _
                  Top:=vungDULieu.Top, Height:=vungDULieu.Height)
      'Copy du lieu dang hinh anh
      vungDULieu.CopyPicture Appearance:=xlScreen, Format:=xlPicture
      'Dan du lieu vao bieu do
      bieuDo.Chart.Paste
      'Xuat du lieu bieu do ra dang hinh anh
      bieuDo.Chart.Export duongDan & "\" & ar(i, 1) & ".png", "PNG"
      'Xoa bieu do trong sheet
      bieuDo.Delete


   Next i
End With




End Sub

thêm code như hình đính kèm

 

[Tuấn Bụng Bự]

thêm code như hình đính kèm

Cảm ơn bác đã hỗ trợ.
Em đã thêm dòng select chọn lại biểu đồ nhưng test lúc được lúc không bác ạ. Tức là thi thoảng vẫn xuất hiện hình ảnh màu trắng ko có dữ liệu.mỗi lần chạy code là 1 hình ảnh trắng theo tên khác nhau

 

[befaint]

Khai báo biến chuẩn chỉ lại là được liền.
100 phát không trượt phát nào nè.

 

[Tuấn Bụng Bự]

Khai báo biến chuẩn chỉ lại là được liền.
100 phát không trượt phát nào nè.

Bác chỉ giùm em xem đã khai báo biến chỗ nào chưa chuẩn như bác nói với ạ