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

[µo°Ý] ÃöÁä¦r§ì¹Ï¤ù

[µo°Ý] ÃöÁä¦r§ì¹Ï¤ù

½Ð°Ý¤@­Ó¸ê®Æ§¨¸Ì­±¦³«Ü¦hªº¹Ï¤ù
§Ú±qC2¶}©l¿é¤JÀɦW
¦ý§Ú¥uª¾¹DÃöÁä¦r
¨Ò¦p:ABCD123456  §Ú¥u¿é¤JABCD
³o¼Ë¤]¯à§ì¨ì¹Ï¤ù
¤U­±ªºµ{¦¡½X­þ¸Ì¦³¿ù¶Ü
³Â·Ð¦U¦ì~À°§Ú¬Ý¤@¤U
Sub Macro1()
    j = 2
    MyPath = "C:\My Pictures\"
    MyFile = Dir(MyPath & Cells(j, "C") & "*.jpg")
    While Cells(j, "C") <> ""
        NN = Cells(j, "C")
        Cells(j, "D").Select
        On Error Resume Next
        ActiveSheet.Pictures.Insert(MyFile).Select
        Selection.ShapeRange.LockAspectRatio = msoTrue
        Selection.ShapeRange.Height = 100#
        Selection.ShapeRange.Width = 100#
        Selection.ShapeRange.Rotation = 0#
        With Selection
        .Placement = xlMoveAndSize
        .PrintObject = True
        End With
    j = j + 1
    Wend
    Range("C2").Select
End Sub

¥»©«³Ì«á¥Ñ GBKEE ©ó 2012-12-12 11:24 ½s¿è

¦^´_ 1# whirlwind963
  1. Option Explicit
  2. Sub Ex()
  3.     Dim j As Integer, MyPath As String
  4.     j = 2
  5.     MyPath = "C:\My Pictures\"
  6.     While Cells(j, "C") <> ""
  7.         If UCase(Cells(j, "C")) Like "*ABCD*" Then  '¦r¦ê¤¤¦³"ABCD"
  8.            'UCase ¨ç¼Æ ¶Ç¦^¤@­Ó Variant (String)¡A©Ò§t¬°Âন¤j¼g¤§¦r¦ê¡C
  9.             Cells(j, "D").Select
  10.            If Dir(MyPath & Cells(j, "C")) <> "" Then
  11.                 With ActiveSheet.Pictures.Insert(MyPath & Cells(j, "C"))
  12.                     '  .ShapeRange.LockAspectRatio = msoTrue
  13.                     '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
  14.                     .ShapeRange.LockAspectRatio = msoFalse
  15.                     .ShapeRange.Height =  100
  16.                     .ShapeRange.Width =  200,
  17.                     .ShapeRange.Rotation = 0
  18.                     .Placement = xlMoveAndSize
  19.                     .PrintObject = True
  20.                 End With
  21.             End If
  22.         End If
  23.         j = j + 1
  24.     Wend
  25.     Range("C2").Select
  26. End Sub
½Æ»s¥N½X

TOP

¦^´_ 2# GBKEE
  1.                     .ShapeRange.Height = 100#
  2.                     .ShapeRange.Width = 100#
  3.                     .ShapeRange.Rotation = 0#
½Æ»s¥N½X
½Ð±Ðª©¤j¡A¤W­±©Ò­z "°ª«×"¡B"¼e«×"ªº³]©w°ÝÃD¡C
°²³]§Ú¹Ï¤ùªº¤j¤p¤£¤@¡A§Ú¦p¦ó¯à±N¨ä¶×¤J°¦¤j¤p­­¨î¡A
(¦p .ShapeRange.Height = 100# ¤§§i¥Ü)
ÁÂÁ±z¡I

TOP

¦^´_ 3# c_c_lai
  1. Option Explicit
  2. Sub Ex()
  3.     With ActiveSheet
  4.         .Pictures.Delete
  5.         .Cells(5, "D").Select
  6.         With .Pictures.Insert("d:\ex1.gif")
  7.             .ShapeRange.LockAspectRatio = msoFalse '¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
  8.             .ShapeRange.Height = IIf(.ShapeRange.Height > 100, 100, .ShapeRange.Height)
  9.             .ShapeRange.Width = IIf(.ShapeRange.Width > 200, 200, .ShapeRange.Width)
  10.             End With
  11.     End With
  12. End Sub
  13.                     
½Æ»s¥N½X

TOP

¦^´_ 4# GBKEE
¯u¤£¦n·N«ä¡Aª¬ªp¨Ì¡A¦pªþ¥ó¡G
My Pictures.rar (315.17 KB)

TOP

¦^´_ 5# c_c_lai
2# ¦³»~ ¤w§ó¥¿
  1. Option Explicit
  2. Sub Ex()
  3.     Dim j As Integer, MyPath As String
  4.     j = 2
  5.     MyPath = "D:\My Pictures\"
  6.     While Cells(j, "C") <> ""
  7.         If UCase(Cells(j, "C")) Like "*ABCD*" Then  '¦r¦ê¤¤¦³"ABCD"
  8.            'UCase ¨ç¼Æ ¶Ç¦^¤@­Ó Variant (String)¡A©Ò§t¬°Âন¤j¼g¤§¦r¦ê¡C
  9.             Cells(j, "D").Select
  10.             Selection.RowHeight = 82
  11.            If Dir(MyPath & Cells(j, "C")) <> "" Then
  12.                 With ActiveSheet.Pictures.Insert(MyPath & Cells(j, "C"))
  13.                     '  .ShapeRange.LockAspectRatio = msoTrue
  14.                     '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
  15.                     .ShapeRange.LockAspectRatio = msoFalse
  16.                     .ShapeRange.Height = IIf(.ShapeRange.Height > 100, 100, .ShapeRange.Height)
  17.                     .ShapeRange.Width = IIf(.ShapeRange.Width > 200, 200, .ShapeRange.Width)
  18.                     .ShapeRange.Rotation = 0#
  19.                     .Placement = xlMoveAndSize
  20.                     .PrintObject = True
  21.                 End With
  22.             End If
  23.         End If
  24.         j = j + 1
  25.     Wend
  26.     Range("C2").Select
  27. End Sub
½Æ»s¥N½X

TOP

¦^´_ 6# GBKEE
§Ú¤w¸g­×¥¿§¹¦¨¡A¦p¹Ï¡AÁÂÁ±z¡I
  1. Option Explicit
  2. Sub Ex()
  3.     Dim j As Integer, MyPath As String
  4.    
  5.     j = 2
  6.     MyPath = "C:\My Pictures\"
  7.    
  8.     While Cells(j, "C") <> ""
  9.         If UCase(Cells(j, "C")) Like "*ABCD*" Then  '¦r¦ê¤¤¦³"ABCD"
  10.            'UCase ¨ç¼Æ ¶Ç¦^¤@­Ó Variant (String)¡A©Ò§t¬°Âন¤j¼g¤§¦r¦ê¡C
  11.             Cells(j, "D").Select
  12.             
  13.             Selection.RowHeight = 100
  14.             Selection.ColumnWidth = 25
  15.             
  16.             On Error Resume Next
  17.             If Dir(MyPath & Cells(j, "C")) <> "" Then
  18.                 With ActiveSheet.Pictures.Insert(MyPath & Cells(j, "C"))
  19.                     '  .ShapeRange.LockAspectRatio = msoTrue
  20.                     '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
  21.                     .ShapeRange.LockAspectRatio = msoFalse
  22.                     .ShapeRange.Height = IIf(.ShapeRange.Height > 98, 98, .ShapeRange.Height)
  23.                     .ShapeRange.Width = IIf(.ShapeRange.Width > 150, 150, .ShapeRange.Width)
  24.                     .ShapeRange.Rotation = 0#
  25.                     .Placement = xlMoveAndSize
  26.                     .PrintObject = True
  27.                 End With
  28.             End If
  29.         End If
  30.         j = j + 1
  31.     Wend
  32.     Range("C2").Select
  33. End Sub
½Æ»s¥N½X

TOP

¦^´_ 6# GBKEE
¤£¦n·N«ä
§Ú·Q­nªº¥¿¦n¬O¬Û¤Ïªº
°²³]ÀɦW¬°ABCD123456.jpg
§Ú¦bC2¿é¤JABCD
D2¯àÅã¥ÜABCD123456.JPGªº¹Ï¤ù

TOP

¦^´_ 8# whirlwind963
  1. Option Explicit

  2. Sub Ex()
  3.     Dim j As Integer, MyPath As String, MyFile As String
  4.    
  5.     j = 2
  6.     MyPath = "C:\My Pictures\"
  7.    
  8.     While Cells(j, "C") <> ""
  9.         If UCase(Cells(j, "C")) Like "*ABCD*" Then  '¦r¦ê¤¤¦³"ABCD"
  10.            '  UCase ¨ç¼Æ ¶Ç¦^¤@­Ó Variant (String)¡A©Ò§t¬°Âন¤j¼g¤§¦r¦ê¡C
  11.             Cells(j, "D").Select
  12.             
  13.             Selection.RowHeight = 100
  14.             Selection.ColumnWidth = 25
  15.             
  16.             On Error Resume Next
  17.             MyFile = Dir(MyPath & "*" & Cells(j, "C") & "*.*")       '  C2 = "ABCD" ->"1AABCD.png"

  18.             If MyFile <> "" Then
  19.                 With ActiveSheet.Pictures.Insert(MyPath & MyFile)
  20.                     '  .ShapeRange.LockAspectRatio = msoTrue
  21.                     '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
  22.                     .ShapeRange.LockAspectRatio = msoFalse
  23.                     .ShapeRange.Height = IIf(.ShapeRange.Height > 98, 98, .ShapeRange.Height)
  24.                     .ShapeRange.Width = IIf(.ShapeRange.Width > 150, 150, .ShapeRange.Width)
  25.                     .ShapeRange.Rotation = 0#
  26.                     .Placement = xlMoveAndSize
  27.                     .PrintObject = True
  28.                 End With
  29.             End If
  30.         End If
  31.         j = j + 1
  32.     Wend
  33.     Range("C2").Select
  34. End Sub
½Æ»s¥N½X

TOP

¦^´_ 8# whirlwind963
  1. Option Explicit
  2. Sub Ex() '¶Ç¦^¸ê®Æ§¨¤¤²Å¦X[C2] ªºÀÉ®×
  3.     Dim j As Integer, MyPath As String, xlJpg As String
  4.     j = 2
  5.     ActiveSheet.Pictures.Delete
  6.     MyPath = "C:\My Pictures\"
  7.     'Dir ¨ç¼Æ ¶Ç¦^¤@­Ó String ¡A¥Î¥Hªí¥Ü¦X¥G±ø¥ó¡BÀÉ®×ÄÝ©Ê¡BºÏºÐ¼Ð°Oªº¤@­ÓÀɮצWºÙ¡B©Î¥Ø¿ý¡BÀɮק¨¦WºÙ¡C
  8.     xlJpg = Dir(MyPath & [C2] & "*.JPG")       '¶}ÀY= [C2]ªº¦r¦ê
  9.    'xlJpg = Dir(MyPath & "*" & [C2] & "*.JPG")  '¥]§t[C2]ªº¦r¦ê
  10.    'xlJpg = Dir(MyPath & "*" & [C2] & ".JPG")   '¥]§t[C2]ªº¦r¦ê¦b§ÀºÝ
  11.     Do While xlJpg <> ""
  12.        Cells(j, "D").Select
  13.         With ActiveSheet.Pictures.Insert(MyPath & xlJpg)
  14.             '  .ShapeRange.LockAspectRatio = msoTrue
  15.             '  ¦b½Õ¾ã¹Ï®×¤j¤p®É¡A¥i¥H¤À§O¦a½Õ¾ã¹Ï®×ªºªø«×©M¼e«×
  16.             .ShapeRange.LockAspectRatio = msoFalse
  17.             .ShapeRange.Height = IIf(.ShapeRange.Height > 98, 98, .ShapeRange.Height)
  18.             .ShapeRange.Width = IIf(.ShapeRange.Width > 150, 150, .ShapeRange.Width)
  19.             .ShapeRange.Rotation = 0#
  20.             .Placement = xlMoveAndSize
  21.             .PrintObject = True
  22.         End With
  23.         j = j + 1
  24.         xlJpg = Dir
  25.     Loop
  26.     Range("C2").Select
  27. End Sub
½Æ»s¥N½X

TOP

        ÀR«ä¦Û¦b : ¦a¤WºØ¤Fµæ¡A´N¤£©öªø¯ó¡F¤ß¤¤¦³µ½¡A´N¤£©ö¥Í´c¡C
ªð¦^¦Cªí ¤W¤@¥DÃD