作者热门文章
- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
我有以下代码在选定范围内插入多个图像:
Private Sub CommandButton1_Click()
Dim sPicture, PhotoCell() As Variant, pic As shape
Dim PictCell As Range
Dim fname As String
Dim I, x As Integer
ActiveSheet.Unprotect Password:="123"
On Error Resume Next
PhotoCell() = Array("K6:P17", "A19:D29", "L19:P29", "A30:D40", "L30:P40", "A41:D51", "L41:P51")
sPicture = Application.GetOpenFilename _
("Pictures (*.jpeg; *.gif; *.jpg; *.bmp; *.tif; *.png), *.jpeg; *.gif; *.jpg; *.bmp; *.tif", 0, "Select Photo", "OK", True)
x = 0
If IsArray(sPicture) Then
For I = LBound(sPicture) To UBound(sPicture)
fname = sPicture(I)
If I Mod 2 = 1 Then
Set PictCell = ActiveSheet.Range(PhotoCell(x))
x = x + 1
Else
Set PictCell = ActiveSheet.Range(PhotoCell(x))
x = x + 1
End If
Set pic = ActiveSheet.Shapes.AddPicture(fname, msoFalse, msoCTrue, 0, 0, 100, 100)
pic.Delete
With pic
.LockAspectRatio = msoFalse
.Height = PictCell.Height
.Width = PictCell.Width
.Top = PictCell.Top
.Left = PictCell.Left
.Placement = xlMoveAndSize
End With
Set pic = Nothing
Next I
ActiveSheet.Protect Password:="123"
Else
MsgBox "No Picture Selected"
End If
End Sub
但是,插入此命令时,我丢失了所有图像对象
pic.Delete
所以实际上我想用新图像替换所选范围内的旧图像,并确保旧图像被完全删除。
最佳答案
尝试这样的事情:
Private Sub CommandButton1_Click()
Const PW As String = "123"
Dim sPictures, sPic, PhotoCell() As Variant, pic As Shape
Dim PictCell As Range
Dim fname As String
Dim x As Long, ws As Worksheet
Set ws = ActiveSheet
PhotoCell() = Array("K6:P17", "A19:D29", "L19:P29", "A30:D40", "L30:P40", "A41:D51", "L41:P51")
sPictures = Application.GetOpenFilename( _
"Pictures (*.jpeg; *.gif; *.jpg; *.bmp; *.tif; *.png), *.jpeg; *.gif; *.jpg; *.bmp; *.tif", 0, _
"Select Photo", "OK", MultiSelect:=True)
x = 0
If IsArray(sPictures) Then
ws.Unprotect PW
For Each sPic In sPictures
Set PictCell = ActiveSheet.Range(PhotoCell(x))
x = x + 1
RemovePicsInRange PictCell 'delete any existing shape in this range
With ws.Shapes.AddPicture(sPic, msoFalse, msoCTrue, 0, 0, 100, 100)
.LockAspectRatio = msoFalse
.Height = PictCell.Height
.Width = PictCell.Width
.Top = PictCell.Top
.Left = PictCell.Left
.Placement = xlMoveAndSize
End With
Next sPic
ActiveSheet.Protect Password:=PW
Else
MsgBox "No Picture Selected"
End If
End Sub
'Delete any shapes whose TopLeftCell intersects with range `rng`
Sub RemovePicsInRange(rng As Range)
Dim i As Long, allPics
Set allPics = rng.Parent.Shapes
For i = allPics.Count To 1 Step -1
If Not Application.Intersect(allPics(i).TopLeftCell, rng) Is Nothing Then
Debug.Print "Deleting shape at " & allPics(i).TopLeftCell.Address
allPics(i).Delete
End If
Next i
End Sub
关于excel - 在插入新图像之前删除所选范围内的所有图像,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/71790886/
我正在尝试用 Swift 编写这段 JavaScript 代码:k_combinations 到目前为止,我在 Swift 中有这个: import Foundation import Cocoa e
我是一名优秀的程序员,十分优秀!