| |
▼Yoshi さん：
>現在写真９６点を写真にp (1)〜p (96)のナンバーを振って、エクセルシート上に
>セルを一つ飛びに挿入・貼り付けています。
>写真の連番には順調に貼り付けられるのですが、
>rand関数を入れて、毎回写真の出るセル位置を変えたいのですが
1 〜 96 を配列に入れて randamにします。
その配列の中身を指定すれば宜しいかと。
尚、検証していないのでバグがあるかもしれません。
Sub Photo_Paste()
Dim m As Long, n As Long, p As Long
Dim CC As Long, RR As Long
Dim R As Range, SP As Shape, WS As Worksheet, FileName As String
' ***** 下記を追加
Const num As Long = 96
Dim sN(1 To num) As Variant
Dim i As Long
SetArray sN, num
' ***** 此処まで
Application.ScreenUpdating = False
On Error Resume Next
With Sheets("Sheet1")
.Activate
For n = 1 To 97
.Rectangles("myPicture" & n).Delete
Next n
'On Error GoTo 0
Set WS = Application.ActiveSheet
p = 1
m = 1
For RR = 2 To 12 Step 2
For CC = 2 To 32 Step 2
Set R = .Cells(RR, CC)
With R
Set SP = Sheets("Sheet1").Shapes.AddShape(msoShapeRectangle, _
.Left, .Top, 39, 38) '''''
FileName = _
ThisWorkbook.Path & "\photo\" & "P" & " " & "(" & sN(p) & ")" & ".jpg"
-----此処を変更
SP.Fill.UserPicture FileName
On Error GoTo 0
End With
p = p + 1
If p >= 98 Then
Exit Sub
End If
m = m + 1
SP.Name = "myPicture" & m - 1
SP.Line.ForeColor.RGB = RGB(0, 0, 0)
SP.Line.Weight = 1.5
Next CC
Next RR
Set SP = Nothing: Set R = Nothing: Set WS = Nothing
End With
Application.ScreenUpdating = True
End Sub
Sub SetArray(sN() As Variant, n As Long)
Dim i As Long
Dim tmp As String
Dim lRnd As Long
For i = 1 To n
sN(i) = i
Next
Randomize
For i = n To 2 Step -1
lRnd = Int(i * Rnd) + 1
tmp = sN(i)
sN(i) = sN(lRnd)
sN(lRnd) = tmp
Next
End Sub
|
|
Yuki
- 12/5/4(金) 15:35 -
