baconbacons

¥H¤Uµ{¦¡½X¥Øªº¬O­n±N¯S©w¸ê®Æ§¨¤¤ªº¬Û¤ù´¡¤J¨ì«ü©wÀx¦s®æ¨Ã¨ÌÀx¦s®æ¤j¤p½Õ¾ã¬Û¤ù¤Ø¤o
¥Ø«e°ÝÃD¥X¦b©ó¡uSet  picNumRng = Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))¡v
¤W­zµ{¦¡§@¥Î¬O¨Ì§Ç©óÀx¦s®æ¡uA5,A29,A54,A78,A103,A127¡K¡v¿é¤J¬Û¤ù¬y¤ô¸¹¡u1,2,3,4,5,6¡K¡v
°õ¦æ«á·|¥X²{°õ¦æ¶¥¬q¿ù»~¡uÀ³¥Îµ{¦¡©Îª«¥ó©w¸q¤Wªº¿ù»~¡v
ºÊ¬Ý¤F¡uRange(¡K) ¡vµo²{¨Ã¤£·|§e²{A5 ©Ò¥H¤]¨S¿ìªk«ü©wµ¹picNumRng
²Ó¬Ý¤F¤@¤U (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0))ªºµ²ªG½T¹ê¬O¥i¥Hºâ¥X§Ú»Ý­nªº®æ¼Æ
¦ý¬O»P Range("A" ¡K)  µLªkµ²¦X¦¨§Ú»Ý­nªºA5 ¬O¦ó­ì¦]¡H
--------------------------------------------------------------------------------------------
Sub photoConv()
    Dim myFSO As New FileSystemObject
    Dim myPath As String, myPic As Object
    Dim E As Range, picNumRng As Object
    Dim myPhoto As String, countPhoto As String
    Dim i As Integer, j As Integer, k As Integer

    myPath = ThisWorkbook.Path                                                                                            '½T»{¬¡­¶Ã¯©Ò¦b¸ô®|
    myPhoto = Dir(myPath & "\" & "­ì©l¬Û¤ù" & "\" & "*.jpg")
    countPhoto = myFSO.GetFolder(myPath & "\" & "­ì©l¬Û¤ù").Files.Count - 1    '¨ú±o¬Û¤ù¼Æ¶q
    If myPhoto <> "" Then                                                                                                           '¸ê®Æ§¨¤¤¦³¬Û¤ù®É½Æ»sªí®æ
        j = 50
        For i = 1 To ((countPhoto + 1) \ 2 - 1)
            Rows("1:49").Copy                                                                                                           '½Æ»sªí®æ
            ActiveSheet.Paste Cells(j, 1)
            j = j + 49
        Next i
        
        For k = 1 To countPhoto                                                                                                   '¿é¤J¬Û¤ù½s¸¹
            Set picNumRng = Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))
            picNumRng = k
                For Each E In picNumRng                                                                                          '³v¤@³B²zÀx¦s®æ
                    Set myPic = ActiveSheet.Pictures.Insert(myPath & E & ".jpg")                '´¡¤J»PÀx¦s®æ¦P¦Wªº¬Û¤ùÀÉ
                        With myPic
                            .ShapeRange.LockAspectRatio = msoFalse
                            .Left = E.Cells(1, 2).Left
                            .Top = E.Cells(1, 2).Top
                            .Width = E.Cells(1, 2).Width
                            .Height = E.Cells(1, 2).Height
                        End With
                Next
        Next
    Else
        MsgBox "¸ê®Æ§¨¤¤¨S¦³¬Û¤ù"
    End If
End Sub

GBKEE

¦^´_ 1# baconbacons
2003ª©¥i¥Hªº

1. Option Explicit
   
2. Sub ex()
   
3.     Dim k, picNumRng As Range
   
4.     For k = 1 To 50 'countPhoto                       '¿é¤J¬Û¤ù½s¸¹
   
5.         Set picNumRng = Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))
   
6.         picNumRng.Select            
   
7.     Next
   
8. End Sub

½Æ»s¥N½X

baconbacons

¦^´_ 2# GBKEE
GBKEE ¤j¡G
                     ­ì¥ýªºµ{¦¡½X¥»¨Ó¦b¿é¤J½s¸¹´N¨S°ÝÃD ¥u¬O¦b´¡¤J¬Û¤ù®É·|¦³¿ù»~²£¥Í
                     §Ú±N­ì©lªºµ{¦¡½X§ï¦¨§A«Øijªº¤è¦¡ ÁÙ¬O¥X²{¤@¼Ëªº¿ù»~°ÝÃD
                     ÁÙ¯à«ç»ò­×§ï©O¡H

GBKEE

¦^´_ 3# baconbacons
§Úªº2003ª©¥i¥Hªº»Ý½Ð¦³2010ª©ªº¬Û§U.

baconbacons

¦^´_ 4# GBKEE
½Ð±Ð GBKEE ¤j¡G
§A©Ò¿×ªº2003¥i¥H¬O«ü¥i¥H¿é¤J¬y¤ô½s¸¹¡AÁÙ¬O»¡³s´¡¤J¹Ï¤ù¤]¥i¥H¡H
¦]¬°§Ú°õ¦æ§A«Øijµ{¦¡½X ¥u¦³¿ï¨ú²Å¦XªºÀx¦s®æ ³Ì«á°±¦bk=50ªº¨º­ÓÀx¦s®æ

¥t¥~½Ð±Ð¤@­Ó For Each... Next ªºÆ[©À°ÝÃD¡H
¬O§_³o­Ó¥Îªk¥u°w¹ï¡u¥¼¹Bºâ°õ¦æ¥¨¶°µ{¦¡«e¡v¤§¡u²Å¦X±ø¥óªº©Ò¦³ª«¥ó¶°¦X¡v¡H
´«¨¥¤§ ´N¬O¥H§Ú¦Û¤vªº³o­Ó¨Ò¤l¨Ó»¡
Set picNumRng = Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))
§Úªºª«¥ó¶°¦XpicNumRng¬O¦bFor Next°j°é°õ¦æ¤§«á ¤~·|¡u³v¤@¡v¹Bºâ²£¥Í²Å¦Xªºª«¥ó
¦Ó¤£¬O¦b¹Bºâ¤§«e´N¤w¸g§¹¥þ±oª¾©Ò¦³ªºª«¥ó
¦b¹B¥Î¦¹ºØ³v¤@²£¥Íªºª«¥ó¬O§_´N¥²¶·¦A·f°tFor Next¥Îªk  ¦Ó¤£¬O For Each... Next
¤£ª¾¹D³o¼Ëªí¹F°÷¤£°÷²M·¡

c_c_lai

¦^´_ 5# baconbacons
¸Õ¸Õ³o­Ó¡G

1. Sub Ex2()
   
2.     Dim myFSO As New FileSystemObject
   
3.     Dim myPath As String, myPic As Object
   
4.     Dim myPhoto As String, countPhoto As Long       '  countPhoto As String
   
5.     Dim picNumRng As Object
   
6.     Dim k As Integer
   
7. 
   
8.     myPath = ThisWorkbook.Path                                                                                            '  ½T»{¬¡­¶Ã¯©Ò¦b¸ô®|
   
9.     countPhoto = myFSO.GetFolder(myPath & "\" & "­ì©l¬Û¤ù").Files.Count          '  ¨ú±o¬Û¤ù¼Æ¶q
   
10.     myPhoto = Dir(myPath & "\" & "­ì©l¬Û¤ù" & "\" & "*.jpg")
    
11.    
    
12.     If myPhoto <> "" Then                                                                                                           '  ¸ê®Æ§¨¤¤¦³¬Û¤ù®É½Æ»sªí®æ
    
13.         For k = 1 To countPhoto                                                                                                   '  ¿é¤J¬Û¤ù½s¸¹
    
14.             Set picNumRng = Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))
    
15.             
    
16.             ActiveSheet.Pictures.Insert (myPath & "\" & "­ì©l¬Û¤ù" & "\" & myPhoto)              '  ´¡¤J»PÀx¦s®æ¦P¦Wªº¬Û¤ùÀÉ
    
17.             With ActiveSheet.Shapes(k)
    
18.                 .LockAspectRatio = msoFalse
    
19.                 .Top = picNumRng.Top
    
20.                 .Left = picNumRng.Left
    
21.                 .Width = 75
    
22.                 .Height = 100
    
23.             End With
    
24.             myPhoto = Dir
    
25.         Next
    
26.     Else
    
27.         MsgBox "¸ê®Æ§¨¤¤¨S¦³¬Û¤ù"
    
28.     End If
    
29. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 5# baconbacons

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim E As Variant, K As Integer, picNumRng As Range
   
4.     For Each E In Workbooks     'Workbookª«¥ó ªº¶°¦Xª«¥ó
   
5.         MsgBox E.Name
   
6.     Next
   
7.     For Each E In Range("A5:C5") 'Cellsª«¥ó ªº¶°¦Xª«¥ó
   
8.         MsgBox E.Address
   
9.     Next
   
10.     For K = 1 To 50     '¶]50¦¸°j°é
    
11.         Set picNumRng = Range("A" & (25 * (K - 1) + 5 - Application.WorksheetFunction.RoundUp((K - 1) / 2, 0)))
    
12.         For Each E In picNumRng 'Cellsª«¥ó ªº¶°¦Xª«¥ó
    
13.             MsgBox E.Address
    
14.         Next
    
15.     Next
    
16. End Sub

½Æ»s¥N½X

baconbacons

¦^´_ 6# c_c_lai
c_c_lai ¤j¡G
¸g¹L­×§ï«á´ú¸Õ ½T¹ê¥i¥H°õ¦æ ¦ý¬O¦]¬°¨Ï¥Î¡uActiveSheet.Shapes(k)¡vªº¥ÎªkªºÃö«Y
¥Ñ©ó§Ú¦b¬¡­¶¤¤¤]³]­p¤F¤@­Ó°õ¦æ«ö¶s ©Ò¥H³o­Ó¥Îªk·|¥h§ì³o­Ó«ö¶sªº¹Ï¥Ü ¦A¶K¨ì§Ú«ü©wÀx¦s®æ
¡]¦pªG¨S¦³³]­p¸Ó«ö¶sªº¸Ü ±z©Ò«Øijªºµ{¦¡½X½T¹ê³£¬O¥i¥H²Å¦X§Úªº»Ý¨Dªº¡^
³o­Ó³¡¤À§Ú¤ñ¤£ª¾¹D«ç»ò§ïµ½ ©Ò¥H´N¸ÕµÛ¨Ï¥ÎGBKEE¤jªº«Øij¤èªk
¤£¹L ÁÙ¬O·PÁÂc_c_lai ¤jªº¨ó§U Åý§Ú¾Ç¨ì .Shapes(k) ¥H¤Î myPhoto = Dir  ªº¥Îªk
·P¿E¡K

baconbacons

¦^´_ 7# GBKEE
GBKEE ¤j¡G
·PÁ²M·¡ªº½d¨Ò¸Ñ¨M§ÚªºÆ[©À°ÝÃD  §Ú¤]§Q¥Î³o­Ó¤p¨Ò¤l§ïµ½§Ú­ì¥ýªºµ{¦¡½X
½T¹ê¤w¸g¥i¥H°õ¦æ¤F ¸U¤À·PÁÂ
¥H¤U¤]¶K¤W§Ú­×§ï«áªºµ{¦¡½X  Åý¦³»Ý­nªº¤H¤]¥i¥H¾Ç²ß
¦pªG¯àÅýµ{¦¡½X§ó²¼äªº¸Ü ¤]½Ð¨ä¥L¤j¤j«ü±Ð
----------------------------------------------------------------------------------------------
Sub photoConv1()
    Dim myFSO As New FileSystemObject
    Dim myPath As String
    Dim picNumRng As Range, myPic As Object
    Dim myPhoto As String, countPhoto As String
    Dim E As Variant
    Dim i As Integer, j As Integer, k As Integer
   
    myPath = ThisWorkbook.Path                                                                                                          '½T»{¬¡­¶Ã¯©Ò¦b¸ô®|
    myPhoto = Dir(myPath & "\" & "­ì©l¬Û¤ù" & "\" & "*.jpg")                                                    '¹Ï¤ùÀɸô®|
    countPhoto = myFSO.GetFolder(myPath & "\" & "­ì©l¬Û¤ù").Files.Count - 1                  '¨ú±o¬Û¤ù¼Æ¶q
    If myPhoto <> "" Then                                                                                                                         '¸ê®Æ§¨¤¤¦³¬Û¤ù®É½Æ»sªí®æ
        j = 50
        ActiveSheet.Cells(27, 3).Value = ActiveSheet.Cells(3, 3).Value
        ActiveSheet.Cells(28, 7).Value = ActiveSheet.Cells(4, 7).Value
        ActiveSheet.Cells(27, 7).Value = ActiveSheet.Cells(3, 7).Value
        ActiveSheet.Cells(27, 8).Value = ActiveSheet.Cells(3, 8).Value
        ActiveSheet.Cells(27, 10).Value = ActiveSheet.Cells(3, 10).Value
        ActiveSheet.Cells(27, 12).Value = ActiveSheet.Cells(3, 12).Value
        ActiveSheet.Cells(27, 14).Value = ActiveSheet.Cells(3, 14).Value
        
        For i = 1 To ((countPhoto + 1) \ 2 - 1)
            Rows("1:49").Copy                                                                                                                          '½Æ»sªí®æ
            ActiveSheet.Paste Cells(j, 1)
            j = j + 49
        Next i
        
        For k = 1 To countPhoto
            Set picNumRng = Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))
                picNumRng = k                                                                                                                            '¿é¤J¬Û¤ù½s¸¹
                For Each E In picNumRng
                Set myPic = ActiveSheet.Pictures.Insert(myPath & "\" & "­ì©l¬Û¤ù" & "\" & E & ".jpg")   '´¡¤J»PÀx¦s®æ¦P¦Wªº¬Û¤ùÀÉ
                With myPic
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Top = picNumRng.Offset(0, 1).Top
                    .Left = picNumRng.Offset(0, 1).Left
                    .Width = picNumRng.Offset(0, 1).MergeArea.Width
                    .Height = picNumRng.Offset(0, 1).MergeArea.Height
                End With
                Next
        Next k
    Else
        MsgBox "¸ê®Æ§¨¤¤¨S¦³¬Û¤ù"
    End If
    Set picNumRng = Nothing
    Set myPic = Nothing
End Sub

GBKEE

¦^´_ 9# baconbacons
Dim myFSO As New FileSystemObject
»Ý³]©w ¤Þ¥Î¶µ¥Ø  Microsoft scripting runtime

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim myFSO As New FileSystemObject
   
4.     Dim picNumRng As Range
   
5.     Dim E As Variant, k As Integer, P As Object               
   
6.     With ActiveSheet        '«ü©w¤u§@ªí
   
7.         .Pictures.Delete    '§R°£ ©Ò¦³¬Û¤ù
   
8.         For Each P In myFSO.GetFolder("d:\¬Û¤ù\74¦~").Files         'Àɮת«¥ó¶°¦X
   
9.             If UCase(P) Like "*.JPG" Then    'P Àɮת«¥ó ¶Ç¦^§¹¾ã¸ô®|¦WºÙ , Like ¤ñ¹ï¬O§_¦³".JPG"ªº¦r¤¸
   
10.                 k = k + 1
    
11.                 Set picNumRng = .Range("A" & (25 * (k - 1) + 5 - Application.WorksheetFunction.RoundUp((k - 1) / 2, 0)))
    
12.                 With picNumRng
    
13.                     .Rows("1:1").RowHeight = 100                   '½Õ¾ã °ª«×
    
14.                     .Columns("A:A").ColumnWidth = 25               '½Õ¾ã ¼e«×
    
15.                 End With
    
16.                 With .Pictures.Insert(P)                           '´¡¤J P Àɮת«¥ó(¬Û¤ù)
    
17.                     .ShapeRange.LockAspectRatio = msoFalse
    
18.                     .Top = picNumRng.Top
    
19.                     .Left = picNumRng.Left
    
20.                     .Width = picNumRng.Width
    
21.                     .Height = picNumRng.Height
    
22.                 End With
    
23.             End If
    
24.         Next
    
25.     End With
    
26.     MsgBox "¸ê®Æ§¨¤¤" & IIf(k > 0, "¦@" & k & "±i", "¨S¦³") & "¬Û¤ù"
    
27. End Sub

½Æ»s¥N½X