Cần chạy macro để nén lại hình ảnh và tự động điều chỉnh kích thướcc

Quảng cáo

LikeIt

Thành viên tiêu biểu
Tham gia ngày
16 Tháng sáu 2006
Bài viết
415
Được thích
253
Điểm
0
Nơi ở
BacNinh
KG các bác,

Các bác cho em xin một con macro để nén được dung lượng hình ảnh và điều chỉnh được kích thước theo như khung đã định sẵn.

Em đã thử kích đúp vào hình ảnh để nén nó lại,sau đó điều chỉnh bằng tay để có kích thước như mong muốn, nhưng khi chạy lại, nó toàn báo lỗi, em không hiểu nhiều về macro nên mong các bác giúp em để tiện khi báo cáo bằng hình ảnh.

Xin cảm ơn
LikeIt
 

File đính kèm

  • VD ve nen hinh anh.rar
    277.3 KB · Đọc: 45

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia ngày
5 Tháng sáu 2008
Bài viết
30,725
Được thích
53,557
Điểm
50
KG các bác,

Các bác cho em xin một con macro để nén được dung lượng hình ảnh và điều chỉnh được kích thước theo như khung đã định sẵn.

Em đã thử kích đúp vào hình ảnh để nén nó lại,sau đó điều chỉnh bằng tay để có kích thước như mong muốn, nhưng khi chạy lại, nó toàn báo lỗi, em không hiểu nhiều về macro nên mong các bác giúp em để tiện khi báo cáo bằng hình ảnh.

Xin cảm ơn
LikeIt
Chức năng Compress Picture e rằng không thể record lại thành 1 macro ---> Khả năng có thể theo tôi là dùng Sendkeys ---> Bạn thử xem!
 

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
10,334
Được thích
30,579
Điểm
9,718
Tuổi
59
Nơi ở
Gò Vấp
Quả thực vụ nén hình không ghi lại được. Chỉ chỉnh kích thước và quăng vô ô thôi.

PHP:
Sub Picture1()
j = 0
For i = 1 To Sheet1.Shapes().Count
With Sheet1.Shapes(i)
If .Type = 13 Then
j = j + 1
    .PictureFormat.ColorType = msoPictureAutomatic
    .Left = Cells(20, (j - 1) * 7 + 2).Left
    .Top = Cells(20, 1).Top
    .LockAspectRatio = msoFalse
    .Width = Range(Cells(1, (j - 1) * 7 + 2), Cells(1, j * 7 - 1)).Width
    .Height = Range("a20:a32").Height
End If
End With
Next
End Sub
 

File đính kèm

  • VD ve nen hinh anh.rar
    284.3 KB · Đọc: 83
Lần chỉnh sửa cuối:

LikeIt

Thành viên tiêu biểu
Tham gia ngày
16 Tháng sáu 2006
Bài viết
415
Được thích
253
Điểm
0
Nơi ở
BacNinh
Xin cảm ơn Bác, nhưng thực sự chưa nén được hình cho dung lượng file giảm xuống bác ạ. VD khi em insert một file hình ảnh có dung lượng 1MB thì khi chạy macro file vẫn giữ dung lượng như vậy, nhưng khi em kích đúp lên trên hình ảnh thu gọn đó thì nén được đáng kể. Mong các bác test thử và em xin một code để giảm được dung lượng hình ảnh xuống để tiện gửi đi gửi lại trên email.tks
 

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia ngày
4 Tháng mười một 2007
Bài viết
10,334
Được thích
30,579
Điểm
9,718
Tuổi
59
Nơi ở
Gò Vấp
Tạm thời vẫn chưa tìm ra code để compress picture, nên hãy dùng 1 trình duyệt ảnh bất kỳ, resize hình trước khi insert.
Chỉ cần ACDSee, không cần PM chỉnh sửa hình ảnh gì đâu, resize hình, chọn option, chỉnh giảm resolution xuống 1 tí là kích thước file giảm đáng kể. Nếu dùng ACDSee còn có thể resize hàng loạt ảnh nữa cơ.

Size hình insert vào Excel thì resize height còn chừng tối đa 480 pixel thôi.
 
Lần chỉnh sửa cuối:

solecao

Thành viên mới
Tham gia ngày
20 Tháng chín 2009
Bài viết
25
Được thích
2
Điểm
0
Quả thực vụ nén hình không ghi lại được. Chỉ chỉnh kích thước và quăng vô ô thôi.

PHP:
Sub Picture1()
j = 0
For i = 1 To Sheet1.Shapes().Count
With Sheet1.Shapes(i)
If .Type = 13 Then
j = j + 1
    .PictureFormat.ColorType = msoPictureAutomatic
    .Left = Cells(20, (j - 1) * 7 + 2).Left
    .Top = Cells(20, 1).Top
    .LockAspectRatio = msoFalse
    .Width = Range(Cells(1, (j - 1) * 7 + 2), Cells(1, j * 7 - 1)).Width
    .Height = Range("a20:a32").Height
End If
End With
Next
End Sub

Mình rất thích thú với đoạn mã chèn hình vào sheet, nhưng hình như trong Excel có lỗi phần property .Left và .Top hay sao ấy. Đối với 1 sheet có cell kích thước bình thường thì nó chèn hình rất chính xác, tuy nhiên nếu kích thước cell nhỏ đi (ví dụ height =10), và mình chèn nhiều hình (ví dụ 20 hình) theo hàng (từ trên xuống dưới) thì nó sẽ chèn không chính xác nữa.


Không biết bạn có gặp trường hợp này chưa và phải làm thế nào để xử lý.
 

rubia

Thành viên mới
Tham gia ngày
21 Tháng bảy 2014
Bài viết
33
Được thích
32
Điểm
303
Tạm thời vẫn chưa tìm ra code để compress picture, nên hãy dùng 1 trình duyệt ảnh bất kỳ, resize hình trước khi insert.
Chỉ cần ACDSee, không cần PM chỉnh sửa hình ảnh gì đâu, resize hình, chọn option, chỉnh giảm resolution xuống 1 tí là kích thước file giảm đáng kể. Nếu dùng ACDSee còn có thể resize hàng loạt ảnh nữa cơ.

Size hình insert vào Excel thì resize height còn chừng tối đa 480 pixel thôi.
Code của anh rất hay, em cũng đang tìm cách để sắp xếp hình vào ô cho đỡ mất công canh chỉnh, trong lúc chỉnh sửa đoạn code để phù hợp với nhu cầu của mình, Giả sử em muốn đặt hình vào 1 ô bị merge (gồm 4 dòng 1 cột) thì có cách nào để VBA nhận biết không ạ?
Em xin đính kèm file do e chỉnh sửa lại từ tác giả,
Em xin cảm ơn ạ
 

File đính kèm

  • VD ve nen hinh anh - change.xls
    257.5 KB · Đọc: 7
Lần chỉnh sửa cuối:

hungtin1997

Dậm chân tại chỗ là đi lùi
Tham gia ngày
16 Tháng mười 2020
Bài viết
91
Được thích
45
Điểm
8
Tuổi
23
Code của anh rất hay, em cũng đang tìm cách để sắp xếp hình vào ô cho đỡ mất công canh chỉnh, trong lúc chỉnh sửa đoạn code để phù hợp với nhu cầu của mình, Giả sử em muốn đặt hình vào 1 ô bị merge (gồm 4 dòng 1 cột) thì có cách nào để VBA nhận biết không ạ?
Em xin đính kèm file do e chỉnh sửa lại từ tác giả,
Em xin cảm ơn ạ
Cùng câu hỏi, mình cũng có trường hợp sử dụng nhiều ảnh trong trang tính nhưng muốn ảnh nằm gọn trong Merge Cell nhưng tìm thì toàn thấy nằm trong 1 ô đơn lẻ.
 

PacificPR

Thành viên mới
Tham gia ngày
6 Tháng năm 2016
Bài viết
1,995
Được thích
2,726
Điểm
1,168
Nơi ở
Cái Bang

File đính kèm

  • Book1.xlsm
    108.3 KB · Đọc: 13
Quảng cáo
Top Bottom