whirlwind963

¦^´_ 10# GBKEE
½Ð°Ý¤@¤U
§Úªº¸ê®Æ§¨¦WºÙ¬O¤é´Á®æ¦¡(2012/12/10)
¤l¸ê®Æ§¨ªº¦WºÙ¬O¤p®É®æ¦¡(00-23)24­Ó¸ê®Æ§¨
¦pªG§Ú¦bA1¿é¤J06  B1¿é¤J12
´N¥i¥H¬Ý¨ì06-12³o¤§¶¡©Ò¦³ªº¹Ï¤ù
³o¼Ëµ{¦¡­n«ç»ò§ï©O

GBKEE

¦^´_ 11# whirlwind963

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim fs, f, e As Variant, i As Integer, xCol As Integer
   
4.     Sheets(1).Activate
   
5.     ActiveSheet.Pictures.Delete
   
6.     xCol = 3    'Äæ¼Æ
   
7.     Set fs = CreateObject("Scripting.FileSystemObject").GetFolder("D:\2012-12-12")
   
8.     '**ÀÉ®×,¸ê®Æ§¨ªº©R¦W¤¤: ¤£¥i¦³  / \ : * ? < > |  ³o¨Ç¦r¤¸
   
9.     For Each e In fs.subfolders  '¸ê®Æ§¨¶°¦Xª«¥ó
   
10.         i = 2       '¦C¼Æ
    
11.         If e.Name >= [A1] And e.Name <= Range("B1") Then '¦pªG§Ú¦bA1¿é¤J06  B1¿é¤J12
    
12.         'If e.Name >= 5 And e.Name <= 10 Then            '5 ¨ì 10
    
13.             For Each f In e.Files    'Àɮ׶°¦Xª«¥ó
    
14.                 i = i + 1
    
15.                 With ActiveSheet.Pictures.Insert(f)
    
16.                     .Top = Cells(i, xCol).Top
    
17.                     .Left = Cells(i, xCol).Left
    
18.                     .Height = 49.5
    
19.                     .Width = 49.5
    
20.                     Cells(i, xCol).RowHeight = .Height
    
21.                     Cells(i, xCol).ColumnWidth = .Width / 5.5
    
22.                 End With
    
23.             Next
    
24.             xCol = xCol + 1   'Äæ¼Æ
    
25.         End If
    
26.     Next
    
27. End Sub

½Æ»s¥N½X

whirlwind963

¦^´_ 12# GBKEE

§Ú¥[¤F If e.Name >= [A1] And e.Name <= Range("B1") Then ³o¤@¦æ«á
µLªkÅã¥Ü¹Ï¤ù­C
½Ð°Ý¦³§Oªº¤èªk¶Ü
ÁÙ¬O­þ¸Ì¿ù¤F©O

GBKEE

¦^´_ 13# whirlwind963
³o¸Ì¦³§ï¶Ü?

1. Set fs = CreateObject("Scripting.FileSystemObject").GetFolder("D:\2012-12-12")
   
2.                       '**ÀÉ®×,¸ê®Æ§¨ªº©R¦W¤¤: ¤£¥i¦³  / \ : * ? < > |  ³o¨Ç¦r¤¸

½Æ»s¥N½X

whirlwind963

¦^´_ 14# GBKEE
¦³ªü
§Ú½T»{ÀɦW¸ò¸ê®Æ§¨³£¨S¦³¨º¨Ç¦r¤¸

whirlwind963

¦^´_ 16# GBKEE
§Ú¥u§ï¤F¸ô®|¦Ó¤w
¨ä¥Lªºµ{¦¡½X³£¤@¼Ë
¦bA1¸òB1¿é¤J¼Æ¦r
ÁÙ¬OµLªkÅã¥Ü¹Ï¤ù

GBKEE

¦^´_ 16# whirlwind963
¤W¶Ç:ÀÉ®×,¸ê®Æ§¨ ¬Ý¬Ý

whirlwind963

¦^´_ 17# GBKEE
¦]¬°¤W¶ÇÀɮתº­­¨î
§Ú§R±¼¤@¨ÇÀÉ®×
³Â·ÐÀ°§Ú´ú¸Õ¬Ý¬Ý

GBKEE

¦^´_ 18# whirlwind963

1. Option Explicit
   
2.     Sub Ex()
   
3.         Dim fs, f, e As Variant, i As Integer, xCol As Integer
   
4.         Sheets(1).Activate
   
5.         ActiveSheet.Pictures.Delete
   
6.         xCol = 3    'Äæ¼Æ
   
7.         Set fs = CreateObject("Scripting.FileSystemObject").GetFolder("D:\2012-12-12")
   
8.         '**ÀÉ®×,¸ê®Æ§¨ªº©R¦W¤¤: ¤£¥i¦³  / \ : * ? < > |  ³o¨Ç¦r¤¸
   
9.         For Each e In fs.subfolders  '¸ê®Æ§¨¶°¦Xª«¥ó
   
10.             i = 2       '¦C¼Æ
    
11.             If Val(e.Name) >= [A1] And Val(e.Name) <= Range("B1") Then '¦pªG§Ú¦bA1¿é¤J06  B1¿é¤J12
    
12.             'If e.Name >= 5 And e.Name <= 15 Then            '5 ¨ì 10
    
13.                 For Each f In e.Files    'Àɮ׶°¦Xª«¥ó
    
14.                     If UCase(f) Like "*.JPG" Or UCase(f) Like "*.GIF" Or UCase(f) Like "*.BMP" Then
    
15.                     '¹w¨¾¤£¬O¹Ï¤ùÀÉ
    
16.                     i = i + 1
    
17.                     With ActiveSheet.Pictures.Insert(f)
    
18.                         .Top = Cells(i, xCol).Top
    
19.                         .Left = Cells(i, xCol).Left
    
20.                         .Height = 49.5
    
21.                         .Width = 49.5
    
22.                         Cells(i, xCol).RowHeight = .Height
    
23.                         Cells(i, xCol).ColumnWidth = .Width / 5.5
    
24.                     End With
    
25.                     End If
    
26.                 Next
    
27.                 xCol = xCol + 1   'Äæ¼Æ
    
28.             End If
    
29.         Next
    
30.     End Sub

½Æ»s¥N½X

c_c_lai

¦^´_ 19# GBKEE
GBKEE ª©¤j¡A ¦­¦w!
§Ú¹ê»Ú´ú¤F¤@°}¤l¡Aµo²{ ¤@°õ¦æ¨ì With ActiveSheet.Pictures.Insert(f)
³o¤@¦æ«K¥X²{ 104 ªº¿ù»~°T®§¡A ¸gÀˬd»yªk¤]¨S¿ù¡A´N¬O·|¦³¿ù»~°T®§¡C
¤]¥O§Ú¦Ê«ä¤£¸Ñ¡C §Ú¥t¥~±N¨ä¤¤ GetFolder ªº³B¸Ì¼Ò²Õ©ñ¤J¨ì¥t¤@¤äµ{¦¡
ùØ´ú¸Õ³£«D±`¥¿±`¡A§Ú±Nµ{¦¡½X  (¦bThisWorkbook°õ¦æ) ªþ¤WÅý±z°Ñ¦Ò¡C

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4.     Dim fs As Object, f As Variant, e As Variant
   
5.     Dim j As Integer, MyPath As String, MyFile As String
   
6.    
   
7.     j = 2
   
8.     MyPath = ActiveWorkbook.Path & "\My Pictures\"
   
9.    
   
10.     Application.ScreenUpdating = False
    
11.    
    
12.     Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(MyPath)
    
13.     For Each e In fs.subfolders  ' ¸ê®Æ§¨¶°¦Xª«¥ó e = "D:\Workspaces\DATA\Excel ½d¨Ò¶°ÀA\TXT\2012-12-12\14"
    
14.         '  For Each f In e.Files  ' Àɮ׶°¦Xª«¥ó f = "D:\Workspaces\DATA\Excel ½d¨Ò¶°ÀA\TXT\2012-12-12\14\Winter.jpg"
    
15.         With Sheets("¤u§@ªí1")
    
16.             .Pictures.Delete
    
17.             While Cells(j, "C") <> ""
    
18.                 If UCase(.Cells(j, "C")) Like "*ABCD*" Then  '¦r¦ê¤¤¦³"ABCD"
    
19.                     'UCase ¨ç¼Æ ¶Ç¦^¤@­Ó Variant (String)¡A©Ò§t¬°Âন¤j¼g¤§¦r¦ê¡C
    
20.                     .Cells(j, "D").Select
    
21.                                        
    
22.                      Selection.RowHeight = 100
    
23.                      Selection.ColumnWidth = 25
    
24.                                             
    
25.                      On Error Resume Next
    
26.                      '   MyFile = Dir(e & "\*" & Cells(j, "C") & "*.*", vbDirectory)
    
27.                      MyFile = Dir(e & "\*" & Cells(j, "C") & "*.*")
    
28.                      If MyFile <> "" Then
    
29.                          '  With .Pictures.Insert(MyPath & MyFile)
    
30.                          With .Pictures.Insert(e & "\" & MyFile)
    
31.                              .Top = Cells(j, "D").Top
    
32.                              .Left = Cells(j, "D").Left
    
33.                              .Height = 90
    
34.                              .Width = 120
    
35.                              .Cells(j, "D").RowHeight = .Height
    
36.                              .Cells(j, "D").ColumnWidth = .Width / 5.5
    
37.                              '  .ShapeRange.LockAspectRatio = msoTrue
    
38.                              '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
    
39.                              '  .ShapeRange.LockAspectRatio = msoFalse
    
40.                              '  .ShapeRange.Height = IIf(.ShapeRange.Height > 98, 98, .ShapeRange.Height)
    
41.                              '  .ShapeRange.Width = IIf(.ShapeRange.Width > 150, 150, .ShapeRange.Width)
    
42.                              '  .ShapeRange.Rotation = 0#
    
43.                              '  .ShapeRange.IncrementLeft 2#
    
44.                              '  .ShapeRange.IncrementTop 1#
    
45.                              '  .Placement = xlMoveAndSize
    
46.                              '  .PrintObject = True
    
47.                          End With
    
48.                          .Cells(j, "E") = MyFile
    
49.                      End If
    
50.                 End If
    
51.                 j = j + 1
    
52.             Wend
    
53.             .Range("C2").Select
    
54.         End With
    
55.         '  Next    '  For Each f In e.Files
    
56.     Next           '  For Each e In fs.subfolders
    
57.     Application.ScreenUpdating = True
    
58. End Sub

½Æ»s¥N½X