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

vba ¦p¦ó­×§ï·s¼W¤½¦¡ ¥i¥H¦Û°Ê¶K¤U¤@±Æ

Sub InsertPictures_5()

Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape, n
On Error Resume Next
'ActiveSheet.Pictures.Delete '§R°£¥þ³¡¹Ï¤ù
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
Set Rng = Application.ActiveCell
If IsArray(PicList) Then
    For lLoop = LBound(PicList) To UBound(PicList)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        n = n + 1
        If n = 5 Then
            n = 0
            Set Rng = Rng.Offset(1, -4)
        Else
            Set Rng = Rng.Offset(0, 1)
        End If
    Next
End If
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

'¶Kº¡5­Ó«á¡A´«¤U¤@±Æ¦b¶K5­Ó....¥H¦¹Ãþ±À
'ª`·N! °õ¦æµ{¦¡«e¥ý¿ï©w¶K¹Ï°õ¦æ¦ì¸m
Sub InsertPictures_5()

Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape, n, Pages
On Error Resume Next
'ActiveSheet.Pictures.Delete '§R°£¥þ³¡¹Ï¤ù
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
Set Rng = Application.ActiveCell
Pages = 5 '±±¨îÅܼơG¶Kº¡5­Ó«á¡A´«¤U¤@±Æ¦b¶K5­Ó
If IsArray(PicList) Then
    For lLoop = LBound(PicList) To UBound(PicList)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        n = n + 1
        If n = Pages Then 'º¡5®æ«á
            n = 0
            Set Rng = Rng.Offset(1, 1 - Pages) '¸õ¤U¤@¦C¡A°h¦^­ì°_ÂI
        Else
            Set Rng = Rng.Offset(0, 1)
        End If
    Next
End If
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

        ÀR«ä¦Û¦b : ¹ï¤÷¥À­nª¾®¦¡A·P®¦¡B³ø®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD