[Help] VBA giảm dung lượng hình ảnh trong Folder

[robinhsoon]

Thân chào cả nhà GPEX!
Mong cả nhà giúp em một việc ạ,

Hiện tại em có:
01. Folder chứa nhiều hình ảnh (>100 Gb)
02. 01 File excel chứa danh sách tên của các hình ảnh trongFolder
Em muốn dùng VBA để giảm dung lượng của các hình ảnh chứa trong Folder xuống khoảng 1 nữa được không ạ.

Ví dụ:
Hình trong Folder LogoGPEX.jpg = 16KB khi chạy tool thì giảm 1 nữa còn 8KB.
VBA có thể giúp được việc này không ạ??
Mong cả nhà giúp đỡ, em chân thành cảm ơn ạ.

 

[anhdepjai]

Có 1 cách như sau, bạn dùng 1 excel để lập trình copy toàn bộ ảnh trong danh sách sang 1 thư mục khác. Sau đó, dùng phần mềm giảm dung lượng ảnh để xử lý cái thư mục mới đó (phần mềm caesium-1.7.0 portable ấy)
Sau đó copy trả lại thư mục cũ là xong

 

[robinhsoon]

Có 1 cách như sau, bạn dùng 1 excel để lập trình copy toàn bộ ảnh trong danh sách sang 1 thư mục khác. Sau đó, dùng phần mềm giảm dung lượng ảnh để xử lý cái thư mục mới đó (phần mềm caesium-1.7.0 portable ấy)
Sau đó copy trả lại thư mục cũ là xong

cảm ơn anh đã quan tâm và chia sẽ em phần mềm trên ạ.
Vì list danh sách hình em có sẵn rồi nên cũng không cần phải copy qua thư mục khác ạ, Mấy của công ty nên không thể chạy được phần mềm có đuôi .exe nên mới khó đó ạ.

Có cách nào lập trình bằng VBA không ạ??

 

[batman1]

Có cách nào lập trình bằng VBA không ạ??

Hãy đính kèm 2 tập tin thực của bạn để tôi thử.

 

[VetMini]

Máy của công ty không cho chạy exe thành thử nhân viên đi đường vòng với VBA.
Cái này hay à nghen.

Gợi ý: ba cái này thuộc về quản lý file và folder. Vào mấy diễn đàn chuyên Windows mà hỏi cách dùng PowerShell hoặc Shell Script.

 

[anhdepjai]

Vậy tôi có 1 cách như sau:
1. Ban chèn file ảnh vào workbook.
2. Bạn lưu ảnh đó vào 1 thư mục tùy chọn, ngay lập tức dung lượng ảnh trong thư mục đó sẽ nhỏ đi.

Vậy để giải quyết bài toán thì bạn cần: chèn ảnh ==> lưu ảnh ==> xóa ảnh đã chèn ==> chèn ảnh khác ==> lưu ảnh

Code để lưu ảnh đây nhé, còn chèn ảnh thì trong diễn đàn đã có nhiều rồi

Sub ExtractImage()

Dim chrt As ChartObject
'getting width and height of picture so the chart can be sized correctly
'if the chart has an other size the picture will be scaled to fit inside the chart area
Dim shp As Shape
Dim t As String
For Each shp In Sheet1.Shapes
W = shp.Width
H = shp.Height
t = shp.Name
Next
Set chrt = ActiveSheet.ChartObjects.Add(0, 0, W, H)
ActiveSheet.Shapes(t).Select
Selection.Copy
chrt.Border.LineStyle = 0 'no border around chart (and picture)
chrt.Select
ActiveChart.Paste
chrt.Chart.Export "D:\" & t & ".jpg", "jpg"
chrt.Delete
Sheet1.Shapes(t).Delete
End Sub

 

[batman1]

Vậy tôi có 1 cách như sau:
1. Ban chèn file ảnh vào workbook.
2. Bạn lưu ảnh đó vào 1 thư mục tùy chọn, ngay lập tức dung lượng ảnh trong thư mục đó sẽ nhỏ đi.

Không hẳn như vậy.

Tôi thử với ảnh 4160 x 3120 "cân nặng" 5,1 MB thì được ảnh 1056 x 792 cân nặng 111 KB. Tất nhiên kích thước có thể chỉ là một chuyện, có thể do ảnh cụ thể nữa chăng. Ta thấy "cân nặng" giảm đi quãng 54 lần. Nhưng kích thước ảnh cũng giảm đi quãng 4 lần cho mỗi chiều, tức diện tích giảm quãng 16 lần. Như vậy thực ra ảnh chỉ giảm ~ 4 lần.

Nhưng có ảnh thì sau khi chạy code lại "béo lên".

Hãy giải nén tập tin đính kèm -> mở tập tin Excel -> chèn bằng tay ảnh thuy.jpg -> chạy code. Trên máy tôi thì trước khi chạy code ảnh 500 x 750 cân nặng 19,2 KB. Sau khi chạy code có ảnh 667 x 1000 cân nặng 51,7 KB. Tức béo lên ~ 2,7 lần.

 

[anhdepjai]

Cơ bản là các ảnh lớn dung lượng nhỏ đi, đề bài thấy 100GB mà . Nên việc vài trăm kb mình nghĩ ko hề gì

 

[batman1]

Cơ bản là các ảnh lớn dung lượng nhỏ đi, đề bài thấy 100GB mà . Nên việc vài trăm kb mình nghĩ ko hề gì

Thế nếu 100 GB đó là hằng hà sa số tập tin nhỏ kiểu thuy.jpg thì sau khi chạy code ta sẽ có 270 GB. Vấn đề là ta chưa biết với những tập tin loại nào (nhỏ?) thì béo lên, với những tập tin nào thì gầy đi.

 

[anhdepjai]

Có cách để làm nhỏ đi mà:
For Each shp In Sheet1.Shapes
W = shp.Width / 2
H = shp.Height / 2
t = shp.Name
Next
Set chrt = ActiveSheet.ChartObjects.Add(0, 0, W, H)

hoặc /3 /4 /5

 

[batman1]

Có cách để làm nhỏ đi mà:
For Each shp In Sheet1.Shapes
W = shp.Width / 2
H = shp.Height / 2
t = shp.Name
Next
Set chrt = ActiveSheet.ChartObjects.Add(0, 0, W, H)

hoặc /3 /4 /5

Thì tôi có nói không có cách đâu? Tôi góp ý cho code bài #1 của bạn mà. Không có lưu ý của tôi thì làm sao có bài này của bạn?

Thực ra nếu góp ý về code thì tôi cũng chả hiểu FOR để làm gì. Nếu cho là luôn luôn trên sheet chỉ có 1 ảnh ở mọi thời điểm thì dĩ nhiên FOR là thừa. Nếu không muốn phụ thuộc vào may rủi và chấp nhận là có thể có 2 hoặc 100 ảnh thì FOR cũng vẫn thừa vì W, H, t luôn là của ảnh cuối. Vậy thì xác định chúng cho ảnh cuối thôi. Nếu thứ tự không quan trọng thì xác định cho ảnh đầu tiên.

 

[robinhsoon]

Vậy tôi có 1 cách như sau:
1. Ban chèn file ảnh vào workbook.
2. Bạn lưu ảnh đó vào 1 thư mục tùy chọn, ngay lập tức dung lượng ảnh trong thư mục đó sẽ nhỏ đi.

Vậy để giải quyết bài toán thì bạn cần: chèn ảnh ==> lưu ảnh ==> xóa ảnh đã chèn ==> chèn ảnh khác ==> lưu ảnh

Code để lưu ảnh đây nhé, còn chèn ảnh thì trong diễn đàn đã có nhiều rồi

Sub ExtractImage()

Dim chrt As ChartObject
'getting width and height of picture so the chart can be sized correctly
'if the chart has an other size the picture will be scaled to fit inside the chart area
Dim shp As Shape
Dim t As String
For Each shp In Sheet1.Shapes
W = shp.Width
H = shp.Height
t = shp.Name
Next
Set chrt = ActiveSheet.ChartObjects.Add(0, 0, W, H)
ActiveSheet.Shapes(t).Select
Selection.Copy
chrt.Border.LineStyle = 0 'no border around chart (and picture)
chrt.Select
ActiveChart.Paste
chrt.Chart.Export "D:\" & t & ".jpg", "jpg"
chrt.Delete
Sheet1.Shapes(t).Delete
End Sub

Em Cảm ơn các Thầy đã giúp đỡ em, em đã làm được và giảm được dung lượng của hình ảnh rồi ạ, nhưng khi em chạy dữ liệu với dung lượng lớn thì bị tình trạng như hình bên dưới, em không biết lý do từ đâu..??
Mong Thầy giúp đỡ ạ.

 

[anhdepjai]

Bạn gửi cái ảnh gốc mà bị mất hình lên cho mình nhé