Execl automatically loads images under the Directory

During the project implementation process, employees were taken photos. However, it is difficult to insert a picture to the employee, and check whether the name is correct or not.

For comprehensive requirements, find relevant information on the Internet. Then summarize the information based on the actual situation. The solution is as follows:

1. Import personnel information

2. Enable the macro function of the execl table and add macros.

3. Deformation of macro code

The Code is as follows:

Sub autoaddpic ()
Application. screenupdating = false


For each SHP in activesheet. Shapes
If SHP. type = msopicture then SHP. Delete
Next
Dim mypcname as string, pictemp as picture
For I = 2 to thisworkbook. activesheet. usedrange. Rows. Count
'If (activesheet. cells (I, 1). value = "name") then

'Activesheet. Pictures (). delete' deletes the original image in the cell.

Mypcname = activesheet. cells (I, 1). Value & activesheet. cells (I, 3). Value & ". jpg"
Activesheet. cells (I, 6). Delete
Activesheet. cells (I, 6). Select
Dim myfile as object
Set myfile = Createobject ("scripting. FileSystemObject ")
'Insert Image
If myfile. fileexists (thisworkbook. Path & "\" & "personnel information" & "\" & mypcname) = true then
Set pictemp = activesheet. Pictures. insert (thisworkbook. Path & "\" & "personnel information" & "\" & mypcname)
'Pictemp. Name = K & K. row' sets the name of the inserted image.
Pictemp. Placement = xlmoveandsize 'sets the size and position of an image as the cell changes.
With pictemp. shaperange
. Lockaspectratio = msofalse 'cancel image Aspect Ratio lock
. Height = cells (I, 6). Height-1 'sets the height of the inserted image to be equal to the height of the cell.
. Width = cells (I, 6). Width-1 'sets the width of the inserted image to be equal to the width of the cell.
End

'Pictemp. Select

Set pictemp = nothing 'reset the image object

End if
'If myfile. fileexists (thisworkbook. Path & "\" & "personnel information" & "\" & mypcname) = false then
'Msgbox thisworkbook. Path & "\" & "111" & "\" & mypcname & "no image"
'Else
'Activesheet. Pictures. insert (thisworkbook. Path & "\" & "" & "\" & mypcname). Select
'End if
'End if

Next I
Application. screenupdating = true

End sub

 

Execl automatically loads directory slices