Nhờ giúp code marco chèn ảnh (1 người xem)

[alinhpt]

Em có code như thế này

Sub CHENANHAUTO()'' CHENANH Macro' Macro recorded 10/24/2015 by TRAN VAN LINH'' Keyboard Shortcut: Ctrl+Shift+L'  '////////ANH SO 1////////  Range("Q23:Q24").Select    ActiveSheet.Pictures.Insert( _        "C:\Windows\system32\config\systemprofile\Desktop\Bu venh base\Du lieu\ANH SO HOA BU VENH\BU VENH LOP 1 86 87\1\1.jpg" _        ).Select    ActiveWindow.SmallScroll Down:=3    Selection.ShapeRange.LockAspectRatio = msoTrue    Selection.ShapeRange.Height = 110.25    Selection.ShapeRange.Width = 220.5    Selection.ShapeRange.Rotation = 0#    With Selection        .Placement = xlMoveAndSize        .PrintObject = True    End With

'///////ANH SO 2///////    Range("Q25:Q26").Select    ActiveSheet.Pictures.Insert( _        "C:\Windows\System32\config\systemprofile\Desktop\Bu venh base\Du lieu\ANH SO HOA BU VENH\BU VENH LOP 1 86 87\1\5.jpg" _        ).Select    Selection.ShapeRange.LockAspectRatio = msoTrue    Selection.ShapeRange.Height = 110.25    Selection.ShapeRange.Width = 220.5    Selection.ShapeRange.Rotation = 0#    With Selection        .Placement = xlMoveAndSize        .PrintObject = True    End With    
'//////ANH SO 3///////    Range("Q27:Q28").Select    ActiveSheet.Pictures.Insert( _        "C:\Windows\System32\config\systemprofile\Desktop\Bu venh base\Du lieu\ANH SO HOA BU VENH\BU VENH LOP 1 86 87\1\3.jpg" _        ).Select    Selection.ShapeRange.LockAspectRatio = msoTrue    Selection.ShapeRange.Height = 110.25    Selection.ShapeRange.Width = 220.5    Selection.ShapeRange.Rotation = 0#    With Selection        .Placement = xlMoveAndSize        .PrintObject = True    End With
'/////////ANH SO 4//////    Range("Q29:Q30").Select    ActiveSheet.Pictures.Insert( _        "C:\Windows\System32\config\systemprofile\Desktop\Bu venh base\Du lieu\ANH SO HOA BU VENH\BU VENH LOP 1 86 87\1\7.jpg" _        ).Select    Selection.ShapeRange.LockAspectRatio = msoTrue    Selection.ShapeRange.Height = 110.25    Selection.ShapeRange.Width = 220.5    Selection.ShapeRange.Rotation = 0#    With Selection        .Placement = xlMoveAndSize        .PrintObject = True    End With    









End Sub

Nhờ anh/chị sửa giùm sao cho nó chạy lặp để chèn dọc theo cột đó liên tục từ Q23,Q24 đế Q150,Q151
Đồng thời cứ 4 ảnh thì đường dẫn folder thay đổi 1, 2, 3...
Em cảm ơn anh chị trước ạ

 

[langtuchungtinh360]

Em có code như thế này

Sub CHENANHAUTO()'' CHENANH Macro' Macro recorded 10/24/2015 by TRAN VAN LINH'' Keyboard Shortcut: Ctrl+Shift+L'  '////////ANH SO 1////////  Range("Q23:Q24").Select    ActiveSheet.Pictures.Insert( _        "C:\Windows\system32\config\systemprofile\Desktop\Bu venh base\Du lieu\ANH SO HOA BU VENH\BU VENH LOP 1 86 87\1\1.jpg" _        ).Select    ActiveWindow.SmallScroll Down:=3    Selection.ShapeRange.LockAspectRatio = msoTrue    Selection.ShapeRange.Height = 110.25    Selection.ShapeRange.Width = 220.5    Selection.ShapeRange.Rotation = 0#    With Selection        .Placement = xlMoveAndSize        .PrintObject = True    End With

'///////ANH SO 2///////    Range("Q25:Q26").Select    ActiveSheet.Pictures.Insert( _        "C:\Windows\System32\config\systemprofile\Desktop\Bu venh base\Du lieu\ANH SO HOA BU VENH\BU VENH LOP 1 86 87\1\5.jpg" _        ).Select    Selection.ShapeRange.LockAspectRatio = msoTrue    Selection.ShapeRange.Height = 110.25    Selection.ShapeRange.Width = 220.5    Selection.ShapeRange.Rotation = 0#    With Selection        .Placement = xlMoveAndSize        .PrintObject = True    End With    
'//////ANH SO 3///////    Range("Q27:Q28").Select    ActiveSheet.Pictures.Insert( _        "C:\Windows\System32\config\systemprofile\Desktop\Bu venh base\Du lieu\ANH SO HOA BU VENH\BU VENH LOP 1 86 87\1\3.jpg" _        ).Select    Selection.ShapeRange.LockAspectRatio = msoTrue    Selection.ShapeRange.Height = 110.25    Selection.ShapeRange.Width = 220.5    Selection.ShapeRange.Rotation = 0#    With Selection        .Placement = xlMoveAndSize        .PrintObject = True    End With
'/////////ANH SO 4//////    Range("Q29:Q30").Select    ActiveSheet.Pictures.Insert( _        "C:\Windows\System32\config\systemprofile\Desktop\Bu venh base\Du lieu\ANH SO HOA BU VENH\BU VENH LOP 1 86 87\1\7.jpg" _        ).Select    Selection.ShapeRange.LockAspectRatio = msoTrue    Selection.ShapeRange.Height = 110.25    Selection.ShapeRange.Width = 220.5    Selection.ShapeRange.Rotation = 0#    With Selection        .Placement = xlMoveAndSize        .PrintObject = True    End With    









End Sub

Nhờ anh/chị sửa giùm sao cho nó chạy lặp để chèn dọc theo cột đó liên tục từ Q23,Q24 đế Q150,Q151
Đồng thời cứ 4 ảnh thì đường dẫn folder thay đổi 1, 2, 3...
Em cảm ơn anh chị trước ạ

cho xin 500 đồng file đi bạn.