Xin code xuất dữ liệu trong excel thành file ảnh đuôi JPG.

[Thanhlam2425]

Mọi người cho mình xin đoạn code copy Picture và lưu ảnh dưới dạng file ảnh.Mình cảm ơn nhiều.

 

[Thanhlam2425]

Ai đi qua vào xem giúp mình được không.Hoặc có ý kiến nào tốt hơn không nhỉ.

 

[quanluu]

Mọi người cho mình xin đoạn code copy Picture và lưu ảnh dưới dạng file ảnh.Mình cảm ơn nhiều.

chẳng hiểu gì cả, lưu ảnh dưới dạng file ảnh thì là điều hiển nhiên rồi. thay vì lưu dữ liệu bảng excel thành ảnh thì có thể lưu pdf, chứ ảnh chắc khó nhằn và phải dùng api

 

[Thanhlam2425]

chẳng hiểu gì cả, lưu ảnh dưới dạng file ảnh thì là điều hiển nhiên rồi. thay vì lưu dữ liệu bảng excel thành ảnh thì có thể lưu pdf, chứ ảnh chắc khó nhằn và phải dùng api

Ví dụ như mình làm bằng thao tác thì mình copy picture rồi paste vào paint rồi lưu lại.Bây giờ muốn dùng VBA không biết có được không.

 

[phulien1902]

Ví dụ như mình làm bằng thao tác thì mình copy picture rồi paste vào paint rồi lưu lại.Bây giờ muốn dùng VBA không biết có được không.

Bạn thử:

Sub ExportRange()
    Const FName As String = "C:\Documents and Settings\HP\My Documents\Downloads\Anh2.jpg" 'Thay doi duong dan ghi File anh
    Dim Rng As Range, shtTemp As Worksheet, chtTemp As Chart
    Application.ScreenUpdating = False
    Set Rng = Worksheets("Sheet1").Range("A1:L10") 'Thay doi Sheet & vung du lieu can tao anh
    Set shtTemp = Worksheets.Add
    Charts.Add
    ActiveChart.Location Where:=xlLocationAsObject, Name:=shtTemp.Name
    Set chtTemp = ActiveChart
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    chtTemp.Paste
    chtTemp.Export Filename:=FName
    Application.DisplayAlerts = False
    shtTemp.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[Thanhlam2425]

Bạn thử:

Sub ExportRange()
    Const FName As String = "C:\Documents and Settings\HP\My Documents\Downloads\Anh2.jpg" 'Thay doi duong dan ghi File anh
    Dim Rng As Range, shtTemp As Worksheet, chtTemp As Chart
    Application.ScreenUpdating = False
    Set Rng = Worksheets("Sheet1").Range("A1:L10") 'Thay doi Sheet & vung du lieu can tao anh
    Set shtTemp = Worksheets.Add
    Charts.Add
    ActiveChart.Location Where:=xlLocationAsObject, Name:=shtTemp.Name
    Set chtTemp = ActiveChart
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    chtTemp.Paste
    chtTemp.Export Filename:=FName
    Application.DisplayAlerts = False
    shtTemp.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Sao mình thử không thấy tạo ra cái file ảnh nào nhỉ bạn.

Bài đã được tự động gộp: 4/10/19

Bạn thử:

Sub ExportRange()
    Const FName As String = "C:\Documents and Settings\HP\My Documents\Downloads\Anh2.jpg" 'Thay doi duong dan ghi File anh
    Dim Rng As Range, shtTemp As Worksheet, chtTemp As Chart
    Application.ScreenUpdating = False
    Set Rng = Worksheets("Sheet1").Range("A1:L10") 'Thay doi Sheet & vung du lieu can tao anh
    Set shtTemp = Worksheets.Add
    Charts.Add
    ActiveChart.Location Where:=xlLocationAsObject, Name:=shtTemp.Name
    Set chtTemp = ActiveChart
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    chtTemp.Paste
    chtTemp.Export Filename:=FName
    Application.DisplayAlerts = False
    shtTemp.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Bạn cho mình hỏi muốn chỉnh cho ảnh nó to lên thì code ở chỗ nào nhỉ bạn.

 

[Thanhlam2425]

Bạn thử:

Sub ExportRange()
    Const FName As String = "C:\Documents and Settings\HP\My Documents\Downloads\Anh2.jpg" 'Thay doi duong dan ghi File anh
    Dim Rng As Range, shtTemp As Worksheet, chtTemp As Chart
    Application.ScreenUpdating = False
    Set Rng = Worksheets("Sheet1").Range("A1:L10") 'Thay doi Sheet & vung du lieu can tao anh
    Set shtTemp = Worksheets.Add
    Charts.Add
    ActiveChart.Location Where:=xlLocationAsObject, Name:=shtTemp.Name
    Set chtTemp = ActiveChart
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    chtTemp.Paste
    chtTemp.Export Filename:=FName
    Application.DisplayAlerts = False
    shtTemp.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Bạn ơi cho mình hỏi là khi mình làm bằng thủ công thì ảnh rất nét nhưng khi chạy code thì bị mờ đi là sao nhỉ bạn.

 

[befaint]

Gửi file của bạn lên mới làm cụ thể được. Kêu lấy ảnh mà chỉ có văn xuôi thì lấy bằng niềm tin và chiến thắng?

Cách đơn giản nhất dùng phần mềm giải nén file rồi kéo/ thả cả cụm "media" ra là xong. Tốn cỡ chục giây.

 

[batman1]

Bạn ơi cho mình hỏi là khi mình làm bằng thủ công thì ảnh rất nét nhưng khi chạy code thì bị mờ đi là sao nhỉ bạn.

Bạn thử thay xlPicture bằng xlBitmap xem sao.

 

[Doãn Quốc Bình]

Mọi người cho mình xin đoạn code copy Picture và lưu ảnh dưới dạng file ảnh.Mình cảm ơn nhiều.

Bạn xem file mình làm có code bạn muốn nhé Link tải: https://terabox.com/s/1GhDuAsn1VY-v4D93jFjuiQ Mã xác nhận tải file: osr2