អំណអគុណចំពោះប្រិយមិត្ត

សូមស្វាគមន៍ចំពោះ ឯកឧត្តម លោកជំទាវ អស់លោក-​លោកស្រី និងប្រិយ៍មិត្ត​អ្នក​អានទាំងអស់ ដែលបានចំណាយពេលវេលាដ៍មានតម្លៃរបស់ខ្លួន​ដេម្បីអាន​សាររបស់ខ្ញុំបាទ​....សូមអរគុណ! Welcome to phengyeat.blogspot.com very thanks for Lok Chumteav, Mr/Ms Ladies and Gentlemen who is visiting and read on my web-blogspot today. Thank you...!

Thursday, September 19, 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



គំរូ



ដកស្រង់ចេញពី​ សេក មាស Excel

1 comment:

  1. កម្មវិធីមេរៀននេះខ្ញុំចំលងពីរគេទេដើម្បីទុករៀននឹងពង្រីកចំនេះដឹងបន្ថែម

    ReplyDelete