Hỏi đáp cách lưu ảnh tự động

[beetune1991]

Xin chào anh chị,

em đang phải làm rất nhiều file ảnh nhưng khi add ảnh thì phải cắt crop rất nhiều bước.
em đang mong muốn giản lướt việc này bằng cách lấy ảnh từ sheet đầu và khi ấn lưu ảnh sẽ tự động nhét vào các ô đã được định sẵn trong các sheet

số báo danh 1 sẽ nhét ảnh vào sheet 1
số báo danh 2 sẽ nhét ảnh vào sheet 2
tương tự thế cho các sheet sau ạ.

các anh chị hỗ trợ e với ạ.

em xin cám ơn

 

[Maika8008]

Xin chào anh chị,

em đang phải làm rất nhiều file ảnh nhưng khi add ảnh thì phải cắt crop rất nhiều bước.
em đang mong muốn giản lướt việc này bằng cách lấy ảnh từ sheet đầu và khi ấn lưu ảnh sẽ tự động nhét vào các ô đã được định sẵn trong các sheet

số báo danh 1 sẽ nhét ảnh vào sheet 1
số báo danh 2 sẽ nhét ảnh vào sheet 2
tương tự thế cho các sheet sau ạ.

các anh chị hỗ trợ e với ạ.

em xin cám ơn

Bạn tùy biến các địa chỉ nguồn và đích để sử dụng nhé.

 

[beetune1991]

Bạn tùy biến các địa chỉ nguồn và đích để sử dụng nhé.

Cho em hỏi tý e chuyển vùng copy từ B3 sang I5 nhưng I5 của em thì đang giống như trong file
cho em hỏi copy làm sao nó nằm gọn ở trong ô em merge mà không bị lòi ra ngoài ạ

 

[batman1]

Cho em hỏi tý e chuyển vùng copy từ B3 sang I5 nhưng I5 của em thì đang giống như trong file
cho em hỏi copy làm sao nó nằm gọn ở trong ô em merge mà không bị lòi ra ngoài ạ

Sửa thành

With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Left = DCell.Left
    .ShapeRange.Top = DCell.Top
    .ShapeRange.Width = DCell.Width
    .ShapeRange.Height = DCell.Height
    DCell = .Name
End With

 

[beetune1991]

Cho em hỏi tý e chuyển vùng copy từ B3 sang I5 nhưng I5 của em thì đang giống như trong file
cho em hỏi copy làm sao nó nằm gọn ở trong ô em merge mà không bị lòi ra ngoài ạ

Code này chỉ có tác dụng ở phần lấy ảnh anh ạ.
anh có làm được ở phần lưu ảnh không ạ.

vì các ô ở các sheet cho có data thường sẽ không đều nhau anh ạ
nên được anh sửa giúp e cả phần lưu ảnh nhé

 

[beetune1991]

Sửa thành

With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Left = DCell.Left
    .ShapeRange.Top = DCell.Top
    .ShapeRange.Width = DCell.Width
    .ShapeRange.Height = DCell.Height
    DCell = .Name
End With

Thêm nữa là có thể chọn nhiều ảnh để cho vào nhiều sheet cùng lúc được không ạ.

 

[be_09]

Xin chào anh chị,

em đang phải làm rất nhiều file ảnh nhưng khi add ảnh thì phải cắt crop rất nhiều bước.
em đang mong muốn giản lướt việc này bằng cách lấy ảnh từ sheet đầu và khi ấn lưu ảnh sẽ tự động nhét vào các ô đã được định sẵn trong các sheet

số báo danh 1 sẽ nhét ảnh vào sheet 1
số báo danh 2 sẽ nhét ảnh vào sheet 2
tương tự thế cho các sheet sau ạ.

các anh chị hỗ trợ e với ạ.

em xin cám ơn

Góp ý cho bạn:
1/ Bạn muốn làm gì đó thì nên nêu rõ mục đích và cái mong muốn thực hiện. Nội dung bài 1 thấy bạn nêu "số báo danh" thì có thể hiểu là bạn muốn theo dõi thông tin cá nhân của học sinh hoặc là muốn in thẻ học sinh.
2/ Nếu đúng theo nội dung trên thì không cần phải theo dõi nhiều sheet, nếu có 1000 học sinh không lẽ bạn làm đến 1000 sheet thì sẽ sẽ khó khăn trong việc tìm kiếm, nếu chứa 1000 ảnh thì dung lượn File tăng rất lớn sẽ làm cho File ì ạch.
3/ Nên chuyển sang hướng theo dõi dữ liệu chỉ trong 1 sheet và sử dụng 1 sheet làm SheetForm để truy vấn dữ liệu và lấy ảnh từ 1 Folder chứa ảnh ra.

 

[beetune1991]

Góp ý cho bạn:
1/ Bạn muốn làm gì đó thì nên nêu rõ mục đích và cái mong muốn thực hiện. Nội dung bài 1 thấy bạn nêu "số báo danh" thì có thể hiểu là bạn muốn theo dõi thông tin cá nhân của học sinh hoặc là muốn in thẻ học sinh.
2/ Nếu đúng theo nội dung trên thì không cần phải theo dõi nhiều sheet, nếu có 1000 học sinh không lẽ bạn làm đến 1000 sheet thì sẽ sẽ khó khăn trong việc tìm kiếm, nếu chứa 1000 ảnh thì dung lượn File tăng rất lớn sẽ làm cho File ì ạch.
3/ Nên chuyển sang hướng theo dõi dữ liệu chỉ trong 1 sheet và sử dụng 1 sheet làm SheetForm để truy vấn dữ liệu và lấy ảnh từ 1 Folder chứa ảnh ra.

em cám ơn anh đã góp ý ạ.
anh batman1 hỗ trợ đúng ý em rồi ạ.
tuy nhiên còn đang hơi nhiều bước
nên em muốn hỏi thử xem có nhận được nhiều file ảnh rồi chia đều được các sheet theo số mình chỉ định không ạ.

 

[be_09]

em cám ơn anh đã góp ý ạ.
anh batman1 hỗ trợ đúng ý em rồi ạ.
tuy nhiên còn đang hơi nhiều bước
nên em muốn hỏi thử xem có nhận được nhiều file ảnh rồi chia đều được các sheet theo số mình chỉ định không ạ.

1/ Tôi chỉ góp ý để bạn có định hướng hoặc suy nghĩ khác đi để làm sao theo dõi cho nhanh, lẹ, thuận tiện.
2/ Vì bạn không có dữ liệu giống thực tế nên tôi cũng chẳng hiểu được ý định của bạn muốn làm cái gì?

 

[batman1]

nên được anh sửa giúp e cả phần lưu ảnh nhé

Nếu tôi hiểu được ý thì

Sub LuuAnh()
Dim ShN As String, ShD As String, PicCell As String
Dim DCell As Range
    
    ShD = Range("B1")  'Ten Sheet luu hinh
    PicCell = "B3"     'Cell luu hinh
    ShN = ActiveSheet.Name 'Ten sheet hien hanh
    Set DCell = Sheets(ShD).Range(PicCell)          '   ActiveSheet.Range("E2") 'Cell chua hinh anh can luu
    
    Application.ScreenUpdating = False
    ActiveSheet.Shapes.Range(Array([E2])).Select
    Selection.Copy
    DCell.PasteSpecial xlPasteAll
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Left = DCell.MergeArea.Left
        .ShapeRange.Top = DCell.MergeArea.Top
        .ShapeRange.Width = DCell.MergeArea.Width
        .ShapeRange.Height = DCell.MergeArea.Height
    End With
    Application.ScreenUpdating = True
    MsgBox "Xong!"
End Sub

Thêm nữa là có thể chọn nhiều ảnh để cho vào nhiều sheet cùng lúc được không ạ.

Muốn được giúp thì chịu khó bỏ thời gian ra nói cho người khác hiểu. Chọn nhiều ảnh có nghĩa là thế nào? Là trước khi nhấn nút thì dùng chuột chọn nhiều ảnh? Để cho vào nhiều sheet cùng lúc là như thế nào? Cho vào những sheet nào, vào vị trí nào của những sheet đó? Tên các sheet và tên các vị trí lấy từ đâu? Từ trên trời?

Hỏi mà như đánh đố thì chịu.

 

[beetune1991]

Nếu tôi hiểu được ý thì

Sub LuuAnh()
Dim ShN As String, ShD As String, PicCell As String
Dim DCell As Range
   
    ShD = Range("B1")  'Ten Sheet luu hinh
    PicCell = "B3"     'Cell luu hinh
    ShN = ActiveSheet.Name 'Ten sheet hien hanh
    Set DCell = Sheets(ShD).Range(PicCell)          '   ActiveSheet.Range("E2") 'Cell chua hinh anh can luu
   
    Application.ScreenUpdating = False
    ActiveSheet.Shapes.Range(Array([E2])).Select
    Selection.Copy
    DCell.PasteSpecial xlPasteAll
    With Selection
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Left = DCell.MergeArea.Left
        .ShapeRange.Top = DCell.MergeArea.Top
        .ShapeRange.Width = DCell.MergeArea.Width
        .ShapeRange.Height = DCell.MergeArea.Height
    End With
    Application.ScreenUpdating = True
    MsgBox "Xong!"
End Sub

Muốn được giúp thì chịu khó bỏ thời gian ra nói cho người khác hiểu. Chọn nhiều ảnh có nghĩa là thế nào? Là trước khi nhấn nút thì dùng chuột chọn nhiều ảnh? Để cho vào nhiều sheet cùng lúc là như thế nào? Cho vào những sheet nào, vào vị trí nào của những sheet đó? Tên các sheet và tên các vị trí lấy từ đâu? Từ trên trời?

Hỏi mà như đánh đố thì chịu.

em cám ơn ạ. được rồi anh ạ.
Liệu có căn chỉnh được % ảnh vào khung không ạ. như hiện tại thì sát lề quá. em muốn ảnh tự động nhỏ đi một tý vào giữa ô đó ạ.

 

[batman1]

em cám ơn ạ. được rồi anh ạ.
Liệu có căn chỉnh được % ảnh vào khung không ạ. như hiện tại thì sát lề quá. em muốn ảnh tự động nhỏ đi một tý vào giữa ô đó ạ.

Cái này đơn thuần là Toán, là Hình học mà. Giả sử khung ảnh dài rộng là w, h, và ảnh cách viền khung là d thì dài rộng của ảnh là:
Width = w - 2d
Height = h - 2d

Giả sử d = 3 thì sửa thành

With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Left = DCell.MergeArea.Left + 3
    .ShapeRange.Top = DCell.MergeArea.Top + 3
    .ShapeRange.Width = DCell.MergeArea.Width - 6
    .ShapeRange.Height = DCell.MergeArea.Height - 6
End With

 

[beetune1991]

Cái này đơn thuần là Toán, là Hình học mà. Giả sử khung ảnh dài rộng là w, h, và ảnh cách viền khung là d thì dài rộng của ảnh là:
Width = w - 2d
Height = h - 2d

Giả sử d = 3 thì sửa thành

With Selection
    .ShapeRange.LockAspectRatio = msoFalse
    .ShapeRange.Left = DCell.MergeArea.Left + 3
    .ShapeRange.Top = DCell.MergeArea.Top + 3
    .ShapeRange.Width = DCell.MergeArea.Width - 6
    .ShapeRange.Height = DCell.MergeArea.Height - 6
End With

được rồi anh ạ.
Tuy nhiên chất lượng ảnh copy ra sheet bị giảm anh ạ
chất lượng em import rất cao nhưng sau khi copy vào sheet chất lượng ảnh bị giảm hơi mờ anh ạ.