[µo°Ý] ¦p¦ó¶×¤J¤£¯S©wªº¹Ï¤ùÀÉ

luke

¦U¦ì¤j¤j

¦p¦ó±q¸ê®Æ§¨¶×¤JBÄæ©Ò¹ïÀ³ªº¦P¦W¹Ï¤ù¦WºÙ
(BÄæ¦WºÙ¬°¦Û¦æ¶ñ¤J)

¦ÜCÄ檺Àx¦s®æ¤º¨Ã²Å¦X¸ÓÀx¦s®æ¤j¤p?
(­YµL¹Ï¤ù«h¸õ¹Lª½¨ìµL¹Ï¤ùÀɦp#4,#8,#12-#14©M#18¨S¦³¹Ï¤ùÀÉ´N­n¸õ¹L)

·Ð½Ð¥ý¶i ¤j¤j«ü¾É
TEST16.rar (713.81 KB)

¤U¸ü¦¸¼Æ: 17

2012-5-3 23:50

oobird

1. Private Sub CommandButton1_Click()
   
2.     Dim shp As Shape, c As Range
   
3.     On Error Resume Next
   
4.     For Each shp In ActiveSheet.Shapes
   
5.         If Not shp.Type = 12 Then shp.Delete
   
6.     Next
   
7. 
   
8.     For Each c In Range("b2", [b65536].End(3))
   
9.         On Error Resume Next
   
10.         c(1, 2).Select
    
11.         Set p = ActiveSheet.Pictures.Insert(ThisWorkbook.Path & "\TEST16\" & c & ".gif")
    
12.         With p
    
13.             .Name = c.Value
    
14.             .Height = c(1, 2).Height
    
15.             .Width = c(1, 2).Width
    
16.             .Placement = xlMoveAndSize
    
17.          End With
    
18.     Next
    
19. 
    
20. End Sub

½Æ»s¥N½X

Hsieh

¦^´_ 1# luke

1. Sub Loadimage()
   
2. fd = ThisWorkbook.Path & "\TEST16\"
   
3. Dim Sp As Shape
   
4. For Each Sp In Sheet1.Shapes
   
5.   If Sp.Type = 13 Then Sp.Delete
   
6. Next
   
7. For Each a In Range([B2], [B65536].End(xlUp))
   
8. fs = fd & a & ".gif"
   
9. If Dir(fs) <> "" Then Sheet1.Shapes.AddPicture fs, msoFalse, msoTrue, a.Offset(, 1).Left, a.Top, a.Offset(, 1).Width, a.Height
   
10. Next
    
11. End Sub

½Æ»s¥N½X