Insert range vào trong shape

Yeuvoyeucon · 24/6/21

Kính gửi anh chị,
Em làm chân chữ ký với shapes mà code không chạy. ANh chị xem giúp em với ạ.
- Đưa vào Shape chân chữ ký với vùng F1,J6
- Copy Shape đến vị trí cần thiết (Ví dụ em copy đến ô A20)
- Co chiều dài của shape bằng độ rộng của vùng tại hàng 11 (Ví dụ đưa ra ở đây là độ rộng tại hàng 11 từ cột A đến cột I)

Yeuvoyeucon · 25/6/21

Anh chị xem giúp em với ạ !

giaiphap · 25/6/21

Yeuvoyeucon đã viết:
Kính gửi anh chị,
Em làm chân chữ ký với shapes mà code không chạy. ANh chị xem giúp em với ạ.
- Đưa vào Shape chân chữ ký với vùng F1,J6
- Copy Shape đến vị trí cần thiết (Ví dụ em copy đến ô A20)
- Co chiều dài của shape bằng độ rộng của vùng tại hàng 11 (Ví dụ đưa ra ở đây là độ rộng tại hàng 11 từ cột A đến cột I)

Hy vọng đúng ý bạn.

Yeuvoyeucon · 25/6/21

giaiphap đã viết:
Hy vọng đúng ý bạn.

Em cảm ơn anh ạ!

befaint · 25/6/21

Cái này không thể làm được.

Range chứa shape(s), chứ shape(s) không thể và không thể chứa Range.

Hai Lúa Miền Tây · 25/6/21

Yeuvoyeucon đã viết:
Kính gửi anh chị,
Em làm chân chữ ký với shapes mà code không chạy. ANh chị xem giúp em với ạ.
- Đưa vào Shape chân chữ ký với vùng F1,J6
- Copy Shape đến vị trí cần thiết (Ví dụ em copy đến ô A20)
- Co chiều dài của shape bằng độ rộng của vùng tại hàng 11 (Ví dụ đưa ra ở đây là độ rộng tại hàng 11 từ cột A đến cột I)

Bạn dùng camera nhé.
Chép code sau vào module.

Mã:

Sub ChupHinh(DiaChiNguon As Range, DiaChiDich As Range)
    Dim ws As Worksheet, shpPic As SHAPE
    Set ws = DiaChiDich.Parent
    DiaChiNguon.Copy
    ws.Pictures.Paste 1
    Set shpPic = ws.Shapes(ws.Shapes.Count)
    With shpPic
        .Top = DiaChiDich.Top
        .Left = DiaChiDich.Left
    End With
    Application.CutCopyMode = False
End Sub

Sau đó chạy code sau:

Mã:

Sub LayHinh()
    ChupHinh Sheet1.Range("F1:J6"), Sheet1.Range("A20")
End Sub

Yeuvoyeucon · 25/6/21

Hai Lúa Miền Tây đã viết:

Bạn dùng camera nhé.
Chép code sau vào module.

Mã:

Sub ChupHinh(DiaChiNguon As Range, DiaChiDich As Range)
    Dim ws As Worksheet, shpPic As SHAPE
    Set ws = DiaChiDich.Parent
    DiaChiNguon.Copy
    ws.Pictures.Paste 1
    Set shpPic = ws.Shapes(ws.Shapes.Count)
    With shpPic
        .Top = DiaChiDich.Top
        .Left = DiaChiDich.Left
    End With
    Application.CutCopyMode = False
End Sub

Sau đó chạy code sau:

Mã:

Sub LayHinh()
    ChupHinh Sheet1.Range("F1:J6"), Sheet1.Range("A20")
End Sub

ANh ơi, em làm lại thành dạng ảnh rồi thay vì Shape. Em muốn cỡ ảnh nó có chiều rộng theo chiều của dòng 15. Em đã làm code như File mà không được. Anh xem giúp em với ạ.

Hai Lúa Miền Tây · 25/6/21

Yeuvoyeucon đã viết:
ANh ơi, em làm lại thành dạng ảnh rồi thay vì Shape. Em muốn cỡ ảnh nó có chiều rộng theo chiều của dòng 15. Em đã làm code như File mà không được. Anh xem giúp em với ạ.

Tôi tạm sửa lại như sau:

Mã:

Sub chanchuky()
    With ActiveSheet.Shapes.Range(Array("Anhchuky"))
       .Width = Range("A15:I15").EntireColumn.Width
       .Top = Range("A24").Top
       .Left = 0
    End With

End Sub

Yeuvoyeucon · 25/6/21

Hai Lúa Miền Tây đã viết:
Tôi tạm sửa lại như sau:

Mã:

Sub chanchuky() With ActiveSheet.Shapes.Range(Array("Anhchuky")) .Width = Range("A15:I15").EntireColumn.Width .Top = Range("A24").Top .Left = 0 End With End Sub

Nếu em xóa giá trị ở H15 và I15 đi thì nó không co gọn lại theo chiều rônngj của dữ liệu mà vẫn bằng độ rộng từ A15 đến cột I15. Có cách gì nó co giản theo độ rộng của trường dữ liệu tại dòng 15 không ạ

thnghiachau · 25/6/21

Yeuvoyeucon đã viết:
Nếu em xóa giá trị ở H15 và I15 đi thì nó không co gọn lại theo chiều rônngj của dữ liệu mà vẫn bằng độ rộng từ A15 đến cột I15. Có cách gì nó co giản theo độ rộng của trường dữ liệu tại dòng 15 không ạ

Bạn nên nhớ rằng theo cách làm này là tạo một "hình ảnh" của một vùng range và dán vào sheet thôi, nên không thể điều chỉnh cái "hình ảnh" này theo cái range nguồn đã tạo đâu nhá!!!!

Hai Lúa Miền Tây · 25/6/21

Yeuvoyeucon đã viết:
Nếu em xóa giá trị ở H15 và I15 đi thì nó không co gọn lại theo chiều rônngj của dữ liệu mà vẫn bằng độ rộng từ A15 đến cột I15. Có cách gì nó co giản theo độ rộng của trường dữ liệu tại dòng 15 không ạ

Thì bạn nói là chiều rộng của nó bằng chiều rộng từ A15 đến I15 mà. Bạn phải chỉnh lại vùng từ A15 đến G15 chứ.

Yeuvoyeucon · 25/6/21

Hai Lúa Miền Tây đã viết:
Thì bạn nói là chiều rộng của nó bằng chiều rộng từ A15 đến I15 mà. Bạn phải chỉnh lại vùng từ A15 đến G15 chứ.

Ý em là chiều rộng tại dòng 15 ứng với dữ liệu ấy ạ. Giống kiểu tìm ô cuối cùng có dữ liệu của một cột ý anh. Nó resize theo vùng có giá trị ạ.

Hai Lúa Miền Tây · 25/6/21

Yeuvoyeucon đã viết:
Ý em là chiều rộng tại dòng 15 ứng với dữ liệu ấy ạ. Giống kiểu tìm ô cuối cùng có dữ liệu của một cột ý anh. Nó resize theo vùng có giá trị ạ.

Bạn cố gắng tự làm bằng cách chọn ô A15 và chỉnh lại vùng rồi ráp nó vô bình thường nhé.

batman1 · 26/6/21

Yeuvoyeucon đã viết:
Ý em là chiều rộng tại dòng 15 ứng với dữ liệu ấy ạ. Giống kiểu tìm ô cuối cùng có dữ liệu của một cột ý anh. Nó resize theo vùng có giá trị ạ.

Xóa cuối có tác dụng còn xóa giữa không xét. Vd. xóa G15 thì vẫn dài tới I15

Mã:

Sub chanchuky()
Dim lastCol As Long, sh As Worksheet
    Set sh = ThisWorkbook.Worksheets("SHAPE")
    lastCol = sh.Cells(15, Columns.Count).End(xlToLeft).Column
    With sh.Shapes.Range(Array("Anhchuky"))
       .Width = sh.Range("A24").Resize(1, lastCol).EntireColumn.Width
       .Top = sh.Range("A24").Top
       .Left = 0
    End With
End Sub

Yeuvoyeucon · 30/6/21

batman1 đã viết:
Xóa cuối có tác dụng còn xóa giữa không xét. Vd. xóa G15 thì vẫn dài tới I15

Mã:

Sub chanchuky() Dim lastCol As Long, sh As Worksheet Set sh = ThisWorkbook.Worksheets("SHAPE") lastCol = sh.Cells(15, Columns.Count).End(xlToLeft).Column With sh.Shapes.Range(Array("Anhchuky")) .Width = sh.Range("A24").Resize(1, lastCol).EntireColumn.Width .Top = sh.Range("A24").Top .Left = 0 End With End Sub

Anh cho em hỏi là có cách gì khi em ở sheet bất kỳ trong File này. Khi em gọi code này thì nó áp dụng được cho sheét bất kỳ đó ạ (Các File đều bắt đầu giữ liệu từ dòng 15 như sheet SHAPE) ạ.

batman1 · 30/6/21

Yeuvoyeucon đã viết:
Anh cho em hỏi là có cách gì khi em ở sheet bất kỳ trong File này. Khi em gọi code này thì nó áp dụng được cho sheét bất kỳ đó ạ (Các File đều bắt đầu giữ liệu từ dòng 15 như sheet SHAPE) ạ.

Bạn thay ThisWorkbook.Worksheets("SHAPE") bằng ActiveSheet nhé.

Yeuvoyeucon · 30/6/21

batman1 đã viết:
Bạn thay ThisWorkbook.Worksheets("SHAPE") bằng ActiveSheet nhé.

Tưởng là vậy nhưng không đúng anh ạ. Em đã thử nhưng không được ạ. Nó chỉ đúng với Sheet nào mà cái SHAPE có tên là Anhchuky được tạo. Còn ở sheet khác mà gọi Anhchuky thì không được ạ.

batman1 · 30/6/21

Yeuvoyeucon đã viết:
Tưởng là vậy nhưng không đúng anh ạ. Em đã thử nhưng không được ạ. Nó chỉ đúng với Sheet nào mà cái SHAPE có tên là Anhchuky được tạo. Còn ở sheet khác mà gọi Anhchuky thì không được ạ

À, tôi không để ý. Thế mỗi sheet đều có cái gọi là "Anhchuky"? Hay là thế nào?

Tôt nhất bạn đính kèm tập tin có 2 sheet như thế. Chiều tối nếu rỗi tôi sẽ xem.

Yeuvoyeucon · 30/6/21

batman1 đã viết:
À, tôi không để ý. Thế mỗi sheet đều có cái gọi là "Anhchuky"? Hay là thế nào?

Tôt nhất bạn đính kèm tập tin có 2 sheet như thế. Chiều tối nếu rỗi tôi sẽ xem.

Dạ đây anh ạ, rõ dễ mà lại thấy khó ạ !

batman1 · 30/6/21

Kiểm tra nhé.

Mã:

Sub chanchuky()
Dim lastCol As Long, k As Long, sh As Worksheet, t
    Set sh = ActiveSheet
    lastCol = sh.Cells(15, Columns.Count).End(xlToLeft).Column
    If sh.Name = "SHAPE" Then
        sh.Shapes.Range(Array("Anhchuky")).Select
    Else
        On Error Resume Next
        sh.Shapes("Anhchuky").Delete
        On Error GoTo 0
        ThisWorkbook.Worksheets("SHAPE").Shapes("Anhchuky").copy
        t = Timer
        Do While Timer - t < 0.6
            DoEvents
        Loop
        sh.Paste
    End If
    With Selection
        If sh.Name <> "SHAPE" Then
            sh.Activate
            Selection.Formula = "=SHAPE!$E$1:$K$6"
        End If
       .Width = sh.Range("A24").Resize(1, lastCol).EntireColumn.Width
       .Top = sh.Range("A24").Top
       .Left = 0
    End With
End Sub

Insert range vào trong shape

Thành viên hoạt động

File đính kèm

Thành viên hoạt động

==(^o^)==

File đính kèm

Thành viên hoạt động

|||||||||||||

❆❆❆❆❆❆❆❆

Thành viên hoạt động

File đính kèm

❆❆❆❆❆❆❆❆

Thành viên hoạt động

Chỉ biết ngồi BÈ và PHÁN chuyện!!!

❆❆❆❆❆❆❆❆

Thành viên hoạt động

❆❆❆❆❆❆❆❆

Thành viên gạo cội

Thành viên hoạt động

Thành viên gạo cội

Thành viên hoạt động

Thành viên gạo cội

Thành viên hoạt động

File đính kèm

Thành viên gạo cội