Tuesday, September 17, 2013

របៀបទាញយករូបភាពជាមួយលក្ខខណ្ឌក្នុងកម្មវិធី Excel


មានពីរជំហាន

ជំហានទីមួយៈ

បង្កើត Module ដោយចុច Alt+F11 ដើម្បីបើក Visual Basic Editor

ចុច Insert ហើយយក Module ហើយ Copy កូដ (ដូចរូបខាងក្រោម)



Code:

'******************************
'* InserPicFromFile           *
'* by: Sekmeas.blogspot.com   *
'* Last Update: 11-Sep-2013   *
'******************************
Sub InsertPicFromFile( _
   strFileLoc As String, _
   rDestCells As Range, _
   blnFitInDestHeight As Boolean, _
   strPicName As String)

   Dim oNewPic As Shape
   Dim shtWS As Worksheet

   Set shtWS = rDestCells.Parent

   On Error Resume Next
   'Delete the named picture (if it already exists)
   shtWS.Shapes(strPicName).Delete
   
   On Error Resume Next
   With rDestCells
      'Create the new picture
      '(arbitrarily sized as a square that is the height of the rDestCells)
      Set oNewPic = shtWS.Shapes.AddPicture( _
         Filename:=strFileLoc, _
         LinkToFile:=msoFalse, _
         SaveWithDocument:=msoTrue, _
         Left:=.Left + 1, Top:=.Top + 1, Width:=.Height - 1, Height:=.Height - 1)
      
      'Maintain original aspect ratio and set to full size
      oNewPic.LockAspectRatio = msoTrue
      oNewPic.ScaleHeight Factor:=5, RelativeToOriginalSize:=msoTrue
      oNewPic.ScaleWidth Factor:=5, RelativeToOriginalSize:=msoTrue
      
      If blnFitInDestHeight = True Then
         'Resize the picture to fit in the destination cells
         oNewPic.Height = .Height + 1.5
      End If
      
      'Assign the desired name to the picture
      oNewPic.Name = strPicName
   End With 'rCellDest
End Sub

បន្ទាប់មកចុចលើ Sheet ណាមួយដែលចង់ប្រើរបៀបទាញរូបភាព ឧទាហរណ៍ Sheet1 (CELENDER) រួច Copy កូដ (ដូចរូបខាងក្រោម)


Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("ID")) Is Nothing Then
         InsertPicFromFile _
            strFileLoc:=Range("Location").Value, _
            rDestCells:=Range("picture"), _
            blnFitInDestHeight:=True, _
            strPicName:="Sekmeas"
   End If
End Sub

រូចចុច Alt+Q ដើម្បីបិទ Visual Basic Editor

ជំហានទី២
បង្កើត Name Manager ចំនួន ៣ដូចជា

- ID កន្លែងវាយឈ្មោះរូប ដើម្បីទាយយករូបភាព ដោយរើស Cell E3:G3 រួចចុច Name Box វាយពាក្យ ID


- Location ជាទីតាំងសម្រាប់ដាក់អាស័យដ្ឋានរូបភាព ដោយរើស Cell A4 រួចចុច Name Box វាយពាក្យ Location បន្ទាប់មកចម្លងទីតាំងរូបភាពដាក់ចូល បើរូបភាពដាក់ក្នុង D:\PICTURE\
សូមវាយដូចនេះ ="D:\PICTURE\"&ID&".JPG"


Picture ជាទីតាំងរូបភាពដែលបង្ហាញ ដោយរើស Cell AA2:AC7 រួចចុច Name Box វាយពាក្យ Picture

0 comments:

Post a Comment

Pulpit rock Pulpit rock Pulpit rock Pulpit rock