ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦p¦ó ´¡¤J ¸ê®Æ§¨¤¤§t¤l¸ê®Æ§¨ªº ¹Ï¤ù

[µo°Ý] ¦p¦ó ´¡¤J ¸ê®Æ§¨¤¤§t¤l¸ê®Æ§¨ªº ¹Ï¤ù

¥»©«³Ì«á¥Ñ oxrain ©ó 2011-9-28 15:06 ½s¿è

½Ð°Ý ¦U¦ì¤j¤j  ­n¦p¦ó´¡¤J ¸ê®Æ§¨¤¤ §t¤l¸ê®Æ§¨  ªº¹Ï¤ù©O
¦]¬°±NªF¦è¥H¸ê®Æ§¨ °µ¤ÀÃþ¦s©ñ

®Ú¥Ø¿ý¦bDºÐ¡A¥D¸ê®Æ§¨¦b D:\PIC ¤Î D:\PIC01
¦Ó D:\PIC ¤¤¦³ 001~070 ¤£µ¥¬ù²ö 50¨Ó­Ó¸ê®Æ§¨
¦Ó D:\PIC01 ¤¤¤]¦³ 010~070 ¬ù40¨Ó­Ó

¥[¤W D:\PIC ¤Î D:\PIC01 ¤U¡A¤]¦³¤£¦b¤l¸ê®Æ§¨ªºjpgÀÉ
½Ð±Ð¦U¦ì«e½ú  ­n¦p¦ó¥[¤J©O¡H·Q»¡¤@­Ó¤@­Ó¦C¡A¦ý·|§Ë­Ó¦n´X¤Ñ¡A¦Ó¥B¦n²Â...>.<
ªþ¤W§Úªºµ{¦¡ÀÉ¡A³Â·Ð¦U¦ì½ç±Ð¡A§ÚªºÀY§Ö­nÃz¤F
  1. Sub ´¡¤J¹Ï¤ù()
  2.         Dim modelno, modelno1, picins As String
  3.         Dim modelno2%
  4.         modelno = InputBox("A1½Ð¿é¤JA1¡BC6½Ð¿é¤JC6¡A¥H¦¹Ãþ±À", "¿é¤J°Ó«~«¬¸¹°_©lÄæ¦ì", "")
  5.         picins = InputBox("´¡¤JAÄæ½Ð¿é¤JA¡B´¡¤JCÄæ½Ð¿é¤JC¡A¥H¦¹Ãþ±À", "¿é¤J°Ó«~¹Ï¤ù´¡¤JÄæ¦ì", "")
  6.         If modelno = "" Or picins = "" Then
  7.           MsgBox("¥½½T¹ê¿é¤J")
  8.         Else
  9.             modelno1 = Left(modelno, 1)
  10.           modelno2 = Mid(modelno, 2, 3)
  11.           Columns("" & picins & ":" & picins & "").Select
  12.           Selection.ColumnWidth = 20
  13.           Rows("" & modelno2 & ":9999").Select
  14.           Selection.RowHeight = 50
  15.           Dim a%
  16.           Dim name As String
  17.             For a = modelno2 To 9999
  18.                 name = Range("" & modelno1 & "" & a & "")
  19.                   If name <> "" Then
  20.                         Range("" & picins & "" & a & "").Select
  21.                           If Dir("D:\PICTURE\001\" & name & ".jpg") <> "" Then
  22.                                 ActiveSheet.Pictures.Insert(P).Select
  23.                                   Selection.ShapeRange.LockAspectRatio = msoTrue
  24.                                   Selection.ShapeRange.Height = 49.5
  25.                                   Selection.ShapeRange.IncrementLeft 0.75
  26.                           Else
  27.                                   Range("" & picins & "" & a & "") = "µL¹Ï¤ù"
  28.                           End If
  29.                 End If
  30.             Next
  31.         End If
  32. End Sub
½Æ»s¥N½X

¦^´_ 1# oxrain
¸Õ¸Õ¬Ý
  1. Dim i As Integer
  2. Sub Ex()
  3.     Dim fs, f, e As Variant
  4.     Sheets(1).Activate
  5.     ActiveSheet.Pictures.Delete
  6.     i = 1
  7.     For Each e In Array("D:\PIC0", "D:\PIC01")
  8.         Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(e)
  9.         ¤l¸ê®Æ§¨ fs
  10.     Next
  11. End Sub
  12. Private Sub ¤l¸ê®Æ§¨(TheFolder)
  13.     Dim fs As Object, f As Object
  14.     Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(TheFolder)
  15.     For Each f In fs.Files
  16.         If UCase(Mid(f, InStr(f, ".") + 1)) = "JPG" Then
  17.              With ActiveSheet.Pictures.Insert(f)
  18.                 .Top = Cells(i, "A").Top
  19.                 .Height = 49.5
  20.                 .ShapeRange.LockAspectRatio = msoTrue
  21.                 .ShapeRange.IncrementLeft 0.75
  22.             End With
  23.             i = i + 5
  24.        End If
  25.     Next
  26.     For Each f In fs.SubFolders
  27.          ¤l¸ê®Æ§¨ f
  28.     Next
  29. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# GBKEE
½Ð°Ý
(1)¥i¥H¿ï¾Ü­n±q­þ¸Ì¶}©l´¡¤J¹Ï¤ù¶Ü?¨Ò¦pC2¶}©l
(2)§Ú­n10­Ó¹Ï´N´«¤@Äæ­n«ç»ò¥Î©O?

TOP

¦^´_ 3# whirlwind963
  1. Dim i As Integer, xCol As Integer
  2. Sub Ex()
  3.     Dim fs, f, e As Variant
  4.     Sheets(1).Activate
  5.     ActiveSheet.Pictures.Delete
  6.     'C2¶}©l
  7.     i = 2       '¦C¼Æ
  8.     xCol = 3    'Äæ¼Æ
  9.     For Each e In Array("D:\¬Û¤ù")
  10.         Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(e)
  11.         ¤l¸ê®Æ§¨ fs
  12.     Next
  13. End Sub
  14. Private Sub ¤l¸ê®Æ§¨(TheFolder)
  15.     Dim fs As Object, f As Object
  16.     Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(TheFolder)
  17.     For Each f In fs.Files
  18.         If UCase(Mid(f, InStr(f, ".") + 1)) = "JPG" Then
  19.              With ActiveSheet.Pictures.Insert(f)
  20.                 '.Top = Cells(i, "A").Top
  21.                  .Top = Cells(i, xCol).Top
  22.                  .Left = Cells(i, xCol).Left
  23.                 .Height = 49.5
  24.                 .Width = 49.5
  25.                 .ShapeRange.LockAspectRatio = msoTrue
  26.                 .ShapeRange.IncrementLeft 0.75
  27.             End With
  28.             i = i + 5
  29.               If i >= 5 * 10 Then  '10­Ó¹Ï´N´«¤@Äæ
  30.                 xCol = xCol + 1
  31.                 i = 2
  32.             End If
  33.        End If
  34.     Next
  35.     For Each f In fs.SubFolders
  36.          ¤l¸ê®Æ§¨ f
  37.     Next
  38. End Sub
½Æ»s¥N½X

TOP

¦^´_ 4# GBKEE
¦A½Ð±Ð¤@­Ó°ÝÃD
¦³¿ìªk¦bCÄæÅã¥Ü¹Ï¤ùDÄæÅã¥Ü¹Ï¤ùªº¦WºÙ¶Ü

TOP

¦^´_ 4# GBKEE
½Ð°Ý¦pªG§Ú¥[¤J
Cells(i, xCol + 1) = f
¨ú±oÀɮצWºÙ
¦³¿ìªk¥u¨ú±oÀɮצWºÙ
¦Ó¤£­n§¹¾ãªº¸ô®|¶Ü
EX:D:\¹Ï¤ù\ABC.JPG
     §Ú¥u­nÅã¥ÜABC.JPG´N¦n

TOP

¦^´_ 2# GBKEE

¦pªG§ï¦¨
NN= cells(2,1)
MM=cells(3,1)
        For Each e In Array(NN,MM)
        Set fs = CreateObject("Scripting.FileSystemObject").GetFolder(e)
        ¤l¸ê®Æ§¨ fs
    Next
·|¥X¿ù
½Ð°Ý¦³¿ìªk¦Û¤v¦bÀx¦s®æ¿é¤J¦ì§}¶Ü

TOP

¦^´_ 7# whirlwind963
5# °Ý :  CÄæÅã¥Ü¹Ï¤ùDÄæÅã¥Ü¹Ï¤ùªº¦WºÙ  §A¤w¦b6# ¦Û¦æ¸Ñµª,

6# °Ý : ¨ú±oÀɮצWºÙ(f.Name),¤£­n§¹¾ãªº¸ô®| f

7# °Ý : Àˬd  NN= cells(2,1),MM=cells(3,1)  ªº¸ô®|¹ï¶Ü?
¦³¿ìªk¦Û¤v¦bÀx¦s®æ¿é¤J¦ì§}¶Ü? ¤£À´§Aªº·N«ä.

TOP

¦^´_ 4# GBKEE
½Ð°Ý¤@¤U
¦pªG§Ú¦³24­Ó¤l¸ê®Æ§¨
§Ú·Q­n
C1Åã¥Ü¤l¸ê®Æ§¨1ªº¦WºÙC2Åã¥Ü¹Ï¤ù
D1Åã¥Ü¤l¸ê®Æ§¨2ªº¦WºÙD2Åã¥Ü¹Ï¤ù
³o¼Ëªº¸Ü¸Ó¦p¦ó§ï©O

TOP

¦^´_ 9# 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:\¬Û¤ù")
  8.     For Each e In fs.subfolders  '¸ê®Æ§¨¶°¦Xª«¥ó
  9.         i = 2       '¦C¼Æ
  10.         Cells(i, xCol) = e.Name
  11.         For Each f In e.Files    'Àɮ׶°¦Xª«¥ó
  12.             If UCase(Mid(f, InStr(f, ".") + 1)) = "JPG" Then
  13.                 i = i + 1
  14.                 With ActiveSheet.Pictures.Insert(f)
  15.                     .Top = Cells(i, xCol).Top
  16.                     .Left = Cells(i, xCol).Left
  17.                     .Height = 49.5
  18.                     .Width = 49.5
  19.                     Cells(i, xCol).RowHeight = .Height
  20.                     Cells(i, xCol).ColumnWidth = .Width / 5.5
  21.                     End With
  22.             End If
  23.         Next
  24.         xCol = xCol + 1   'Äæ¼Æ
  25.     Next
  26. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¤H¥Í³Ì¤jªº¦¨´N¬O±q¥¢±Ñ¤¤¯¸°_¨Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD