Hsieh

¦^´_ 1# cmo140497


    [url]http://chijanzen.net/wp/?p=495[/url]

Hsieh

¦^´_ 5# cmo140497
§Aªº¥Øªº¬°¦ó§Ú¤£ª¾¹D¡A¦ý­n·s¼W¹Ï¤ù¥u­n§ï¦¨¥H¤U¬yµ{§Y¥i

1. Sub STARTGETSINF()
   
2. Dim Fs As Object, E, i As Integer, P, ii As Integer
   
3.     Dim xlPath As String
   
4.     Dim myWb As Workbook
   
5.     Dim myFileName As String
   
6. Cells.Clear
   
7. ActiveWindow.Zoom = 75
   
8. Rows("2:9999").EntireRow.AutoFit
   
9. Columns("B:Y").ColumnWidth = 2
   
10. 
    
11. With Application.FileDialog(msoFileDialogFolderPicker)
    
12.         .AllowMultiSelect = False
    
13.         .InitialFileName = "D:\Export\SINF\"
    
14.         .Show
    
15.         If .SelectedItems.Count = 0 Then Exit Sub
    
16.         xlPath = .SelectedItems(1)
    
17. End With
    
18. 
    
19. With CreateObject("Scripting.FileSystemObject").GetFolder(xlPath)
    
20.         i = 1
    
21.         For Each E In .SubFolders
    
22.             If i > ActiveWorkbook.Sheets.Count Then
    
23.                 Sheets.Add(, Sheets(Sheets.Count)).Name = E.Name
    
24.             Else
    
25.                 Sheets(i).Name = E.Name
    
26.             End If
    
27.             ii = 2
    
28.            For Each P In E.Files
    
29.               If InStr(UCase(P.Name), ".JPG") Then
    
30.                 ActiveWindow.Zoom = 75
    
31.                                                 
    
32.                 With Sheets(i).Cells(ii, 2).Select                         '³]©w¹Ï¤ùÄæ¦ì¤j¤p
    
33.                      With Selection
    
34.                       .RowHeight = 60
    
35.                       .ColumnWidth = 9.5
    
36.                       .WrapText = True
    
37.                      End With
    
38.                      
    
39.                       t = Cells(ii, 2).Top + Cells(ii, 2).Height * 0.1  '¹Ï¤ù¤W¦ì¸m
    
40.                       l = Cells(ii, 2).Left + Cells(ii, 2).Width * 0.1 '¹Ï¤ù¥ª¦ì¸m
    
41.                       w = 50                                          '¹Ï¤ùÁY¤p50%¼e«×
    
42.                       h = 50                                         '¹Ï¤ùÁY¤p50%°ª«×
    
43. 
    
44.                   With Sheets(i).Shapes.AddPicture(P, True, True, l, t, w, h) 'BÄæ´¡¤J¹Ï¤ù
    
45.                       .Placement = xlMove                        '¹Ï¤ù¤j¤pÀHÀx¦s®æ¦ì¸m¦Ó§ïÅÜ
    
46. 
    
47.                          With Sheets(i)                                    'AÄæ´¡¤J¹Ï¤ù¦WºÙ
    
48.                            '.Cells(ii, 1) = P.Name                          '¹Ï¤ùÀɮצWºÙ
    
49.                            .Cells(ii, 1) = P                              '¹Ï¤ùÀɮק¹¾ã¸ô®|
    
50.                          End With
    
51.                   End With
    
52.                 End With
    
53.                 ii = ii + 1                                                '¤@¦¸¸õªºÄæ¦ì¼Æ
    
54.               End If
    
55.             Next
    
56.         Next
    
57.     End With
    
58.    
    
59. End Sub

½Æ»s¥N½X