Insert range vào trong shape

[Yeuvoyeucon]

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]

Kiểm tra nhé.

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

Quá giỏi anh ạ ! Để em đọc và học Code ạ !!!!! Em cảm ơn anh.