Lỗi khi mỗi lần chạy code hình ảnh lưu trong excel bị mờ đi. (1 người xem)

[Thanhlam2425]

Các anh chị trong GPE cho em hỏi.
Em gặp lỗi là mỗi khi em dùng code copy 1 ảnh nào đó trong sheets.Rồi paste vào sheets khác thì ảnh trong sheets bị copy nó bị mờ đi.Rất khó nhìn.
Anh chị cho em hỏi nó là bị lỗi gì ạ.Em cảm ơn.
Code của em viết lấy ảnh đây ạ.

Sub xemanh()
    Dim s As String
      With Sheets("show")
        .Unprotect 123   'code mo pass
         s = .Range("A5").Value & "KT"
       If kiemtra("PIC1", Sheets("show")) = True Then
             .Shapes("PIC1").Delete
       End If
       If kiemtra(s, Sheets("log")) = True Then
             Sheets("log").Shapes(s).Copy
             .Activate
             .Paste
             With Selection
                 .name = "PIC1"
                 .ShapeRange.LockAspectRatio = False
                 .Left = [A7:E7].Left
                 .Top = [A7:E7].Top
                 .Width = [A7:E7].Width
                 .Height = [A7:E7].Height
            End With
       End If
        s = .Range("A5").Value & "TQ"
       If kiemtra("PIC2", Sheets("show")) = True Then
             .Shapes("PIC2").Delete
       End If
       If kiemtra(s, Sheets("log")) = True Then
             Sheets("log").Shapes(s).Copy
             .Activate
             .Paste
             With Selection
                 .name = "PIC2"
                 .ShapeRange.LockAspectRatio = False
                 .Left = [F7:H7].Left
                 .Top = [F7:H7].Top
                 .Width = [F7:H7].Width
                 .Height = [F7:H7].Height
            End With
       End If
       .Protect 123   'code dong pass
      End With
End Sub

 

[Hoàng Trọng Nghĩa]

Các anh chị trong GPE cho em hỏi.
Em gặp lỗi là mỗi khi em dùng code copy 1 ảnh nào đó trong sheets.Rồi paste vào sheets khác thì ảnh trong sheets bị copy nó bị mờ đi.Rất khó nhìn.
Anh chị cho em hỏi nó là bị lỗi gì ạ.Em cảm ơn.
Code của em viết lấy ảnh đây ạ.

Sub xemanh()
    Dim s As String
      With Sheets("show")
        .Unprotect 123   'code mo pass
         s = .Range("A5").Value & "KT"
       If kiemtra("PIC1", Sheets("show")) = True Then
             .Shapes("PIC1").Delete
       End If
       If kiemtra(s, Sheets("log")) = True Then
             Sheets("log").Shapes(s).Copy
             .Activate
             .Paste
             With Selection
                 .name = "PIC1"
                 .ShapeRange.LockAspectRatio = False
                 .Left = [A7:E7].Left
                 .Top = [A7:E7].Top
                 .Width = [A7:E7].Width
                 .Height = [A7:E7].Height
            End With
       End If
        s = .Range("A5").Value & "TQ"
       If kiemtra("PIC2", Sheets("show")) = True Then
             .Shapes("PIC2").Delete
       End If
       If kiemtra(s, Sheets("log")) = True Then
             Sheets("log").Shapes(s).Copy
             .Activate
             .Paste
             With Selection
                 .name = "PIC2"
                 .ShapeRange.LockAspectRatio = False
                 .Left = [F7:H7].Left
                 .Top = [F7:H7].Top
                 .Width = [F7:H7].Width
                 .Height = [F7:H7].Height
            End With
       End If
       .Protect 123   'code dong pass
      End With
End Sub

Trước khi End Sub bạn chỉ cần thêm câu lệnh: Range("A1").Select
chỉ thế thôi.

 

[saobekhonglac]

Các anh chị trong GPE cho em hỏi.
Em gặp lỗi là mỗi khi em dùng code copy 1 ảnh nào đó trong sheets.Rồi paste vào sheets khác thì ảnh trong sheets bị copy nó bị mờ đi.Rất khó nhìn.
Anh chị cho em hỏi nó là bị lỗi gì ạ.Em cảm ơn.
Code của em viết lấy ảnh đây ạ.

Sub xemanh()
    Dim s As String
      With Sheets("show")
        .Unprotect 123   'code mo pass
         s = .Range("A5").Value & "KT"
       If kiemtra("PIC1", Sheets("show")) = True Then
             .Shapes("PIC1").Delete
       End If
       If kiemtra(s, Sheets("log")) = True Then
             Sheets("log").Shapes(s).Copy
             .Activate
             .Paste
             With Selection
                 .name = "PIC1"
                 .ShapeRange.LockAspectRatio = False
                 .Left = [A7:E7].Left
                 .Top = [A7:E7].Top
                 .Width = [A7:E7].Width
                 .Height = [A7:E7].Height
            End With
       End If
        s = .Range("A5").Value & "TQ"
       If kiemtra("PIC2", Sheets("show")) = True Then
             .Shapes("PIC2").Delete
       End If
       If kiemtra(s, Sheets("log")) = True Then
             Sheets("log").Shapes(s).Copy
             .Activate
             .Paste
             With Selection
                 .name = "PIC2"
                 .ShapeRange.LockAspectRatio = False
                 .Left = [F7:H7].Left
                 .Top = [F7:H7].Top
                 .Width = [F7:H7].Width
                 .Height = [F7:H7].Height
            End With
       End If
       .Protect 123   'code dong pass
      End With
End Sub

Chắc là do thay đổi kích thước hình nên ảnh hưởng đến độ phân giải, khi copy hình vào excel hay word rồi lưu lại dạng hình là hay bị như vậy.

 

[Hoàng Trọng Nghĩa]

Chắc là do thay đổi kích thước hình nên ảnh hưởng đến độ phân giải, khi copy hình vào excel hay word rồi lưu lại dạng hình là hay bị như vậy.

Mặc dù tôi chả biết thủ tục bạn đó viết thế nào cả, nhưng nhìn code là thấy bạn đó đang Select cái hình nào đó, thực tế mình chọn một hình nào đó trên sheet, nó cũng mờ mờ thế thôi, cho nên mình trỏ nó xuống một ô nào đó trong sheet mình select, thế là hình ảnh không bị active nữa, hết mờ!

 

[Thanhlam2425]

Mặc dù tôi chả biết thủ tục bạn đó viết thế nào cả, nhưng nhìn code là thấy bạn đó đang Select cái hình nào đó, thực tế mình chọn một hình nào đó trên sheet, nó cũng mờ mờ thế thôi, cho nên mình trỏ nó xuống một ô nào đó trong sheet mình select, thế là hình ảnh không bị active nữa, hết mờ!

Có nghĩa là bây giờ mình không chọn theo tên ảnh mà chọn theo vùng chứa tên ảnh hả anh.

 

[Hoàng Trọng Nghĩa]

Có nghĩa là bây giờ mình không chọn theo tên ảnh mà chọn theo vùng chứa tên ảnh hả anh.

Hãy xem lại bài #2. Chỉ thêm dòng lệnh đó cuối cùng.

 

[Thanhlam2425]

Hãy xem lại bài #2. Chỉ thêm dòng lệnh đó cuối cùng.

Em thêm rồi nhưng không được.Ý anh là muốn select cái sheets đang chứa ảnh hay là sheets được copy sang ạ.

 

[Hoàng Trọng Nghĩa]

Em thêm rồi nhưng không được.Ý anh là muốn select cái sheets đang chứa ảnh hay là sheets được copy sang ạ.

Nếu vậy thì thêm tên sheet vào:
Sheets("log").Select
Range("A1").Select

 

[Thanhlam2425]

Nếu vậy thì thêm tên sheet vào:
Sheets("log").Select
Range("A1").Select

Vâng cảm ơn anh ạ.

 

[Thanhlam2425]

Nếu vậy thì thêm tên sheet vào:
Sheets("log").Select
Range("A1").Select

Anh ơi em phát hiện lỗi ở chỗ là khi mình Save thì nó mới bị sửa ảnh.Có nghĩa là nó lưu ảnh theo kích thước hiện tại.Trong excel em để ảnh nhỏ.Nhưng khi chuyển sang chỗ khác em để ảnh to hơn nên nó bị nhòe.Có cách nào khắc phục không anh.

 

[Hoàng Trọng Nghĩa]

Anh ơi em phát hiện lỗi ở chỗ là khi mình Save thì nó mới bị sửa ảnh.Có nghĩa là nó lưu ảnh theo kích thước hiện tại.Trong excel em để ảnh nhỏ.Nhưng khi chuyển sang chỗ khác em để ảnh to hơn nên nó bị nhòe.Có cách nào khắc phục không anh.

Nhòe là do file hình quyết định, không nên copy từ sheet này qua sheet khác, mà dùng thủ tục load từ folder lên sheet luôn. Sau khi thoát file delete nó để cho nhẹ file.

 

[Thanhlam2425]

Nhòe là do file hình quyết định, không nên copy từ sheet này qua sheet khác, mà dùng thủ tục load từ folder lên sheet luôn. Sau khi thoát file delete nó để cho nhẹ file.

Vâng em cảm ơn anh.Em đã khắc phục được rồi ạ.