關於excel vba代碼一問
想請教,當我執行代碼之後
要讓圖片和產生的圖形楕圓框做群組,要怎麼做修改???
請大哥大姐們幫忙看一下,謝謝您~假日愉快
Sub InsertPictureWithRedOvalInGColumn()
Dim ws As Worksheet
Dim pic As Picture
Dim picPath As Variant
Dim fd As FileDialog
Dim rng As Range
Dim targetCell As Range
Dim foundCell As Boolean
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.AllowMultiSelect = True
.Title = "選擇圖片"
.Filters.Add "圖片檔案", "*.jpg; *.jpeg; *.png; *.gif"
If .Show = -1 Then
For Each picPath In .SelectedItems
Set rng = ws.Range("G3:G" & ws.Cells(ws.Rows.Count, "G").End(xlUp).Row)
Set targetCell = rng.Cells(3)
foundCell = False
For Each pic In ws.Pictures
If Not Intersect(pic.TopLeftCell, targetCell) Is Nothing Then
Set targetCell = targetCell.Offset(1)
End If
Next pic
Set pic = ws.Pictures.Insert(picPath)
pic.shapeRange.LockAspectRatio = msoFalse
pic.Width = targetCell.Width
pic.Height = targetCell.Height
pic.Top = targetCell.Top
pic.Left = targetCell.Left
Dim ovalWidth As Double
Dim ovalHeight As Double
ovalWidth = pic.Width / 2
ovalHeight = pic.Height / 2
Dim oval As Shape
Set oval = ws.shapes.AddShape(msoShapeOval, pic.Left + (pic.Width - ovalWidth) / 2, _
pic.Top + (pic.Height - ovalHeight) / 2, ovalWidth, ovalHeight)
oval.Fill.Visible = msoFalse
oval.Line.ForeColor.RGB = RGB(255, 0, 0)
Set targetCell = targetCell.Offset(1)
Next picPath
Else
Exit Sub
End If
End With
End Sub