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




			
		- Tham gia
 - 10/3/07
 
- Bài viết
 - 5,802
 
- Được thích
 - 6,912
 
Chúng ta thường copy cell và paste Picture Link... Thêm 1 cách nữa bằng VBA cũng có chức năng chụp hình cell tương tự, nhưng khi thao tác thì nhanh hơn rất nhiều... Các bạn chạy code này thử xem:
 
Sub CHUPHINHCEL()
Dim MyPrompt As String
Dim MyTitle As String
Dim UserRange As Range
Dim OutputRange As Range
Application.ScreenUpdating = True
MyPrompt = "CHON KHU VUC CAN CHUP HINH"
MyTitle = "CHUP HINH CELL"
On Error Resume Next
Set UserRange = Application.InputBox(Prompt:=MyPrompt, _
Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
If UserRange Is Nothing Then End
On Error GoTo 0
UserRange.CopyPicture
MyPrompt = "CHON KHU VUC MA BAN MUON DAN HINH VAO"
MyTitle = "DAN HINH"
On Error Resume Next
Set OutputRange = Application.InputBox(Prompt:=MyPrompt, _
Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
If OutputRange Is Nothing Then End
On Error GoTo 0
OutputRange.PasteSpecial
Selection.Formula = UserRange.Address
End Sub
 
Mến
ANH TUẤN
				
			Sub CHUPHINHCEL()
Dim MyPrompt As String
Dim MyTitle As String
Dim UserRange As Range
Dim OutputRange As Range
Application.ScreenUpdating = True
MyPrompt = "CHON KHU VUC CAN CHUP HINH"
MyTitle = "CHUP HINH CELL"
On Error Resume Next
Set UserRange = Application.InputBox(Prompt:=MyPrompt, _
Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
If UserRange Is Nothing Then End
On Error GoTo 0
UserRange.CopyPicture
MyPrompt = "CHON KHU VUC MA BAN MUON DAN HINH VAO"
MyTitle = "DAN HINH"
On Error Resume Next
Set OutputRange = Application.InputBox(Prompt:=MyPrompt, _
Title:=MyTitle, Default:=ActiveCell.Address, Type:=8)
If OutputRange Is Nothing Then End
On Error GoTo 0
OutputRange.PasteSpecial
Selection.Formula = UserRange.Address
End Sub
Mến
ANH TUẤN
	
	  