vba中shape运用问题

lvxiaoma11 2021-04-02 10:26:41

本人刚刚学习写VBA代码，磕磕碰碰。目前遇到问题请高手指点。
背景：将sheet2中匹配的二维码图片黏贴到sheet1中相应的区域range中.。匹配元素：“设备编号：****-*****-*****-****”。
问题：1.图片通过改变大小尺寸，能够适应sheet1 区域要求，但同步sheet2排列好的二维码跟着变化位置及尺寸！
2.这个区别于shapes.addpicture图片处理方式。那么这个是如何设置图片居中的？
Sub 测试()
Dim f As String
Dim f1 As String
Dim h As String
Dim w As Integer
Dim y As Integer
Dim z As Integer
Dim x As Integer
Dim w1 As Integer
Dim tp As Range
Dim rng As Range
Dim i As Integer, shps
Dim shps1
For x = 1 To 20
For y = 1 To 20
For w = 1 To 20
For z = 1 To 20
Application.ScreenUpdating = False
f = Sheet1.Cells(x, y).Text
h = Left(Sheet2.Cells(w, z), 5)
If h = "设备编号：" Then
Worksheets("Sheet2").Activate
f1 = Right(Cells(w, z), Len(Cells(w, z)) - 5)
If f = f1 Then
'tp = Range(Sheet2.Cells(x + 2, y))
'Range(Sheet1.Cells(w - 1, z - 3)) = tp
Worksheets("sheet2").Select
w1 = w - 2
Set rng = Sheet2.Range(Cells(w1, z), Cells(w1 + 1, z))
Set shps = rng.Worksheet.Shapes
For i = shps.Count To 1 Step -1 '倒序循环图片
If Not Intersect(shps(i).TopLeftCell, rng) Is Nothing Then '检测到图片位置与本区域重叠则删除
Worksheets("Sheet1").Activate
Set shps1 = shps(i)
With shps1
.Left = 3
.Top = 3
.Width = Cells(x - 2, y - 3).Width + Cells(x - 2, y - 2).Width - 1
.Height = Cells(x - 2, y).Height + Cells(x - 1, y).Height + Cells(x + 1, y).Height + Cells(x, y).Height - 1
End With
shps1.Copy
Range(Cells(x - 2, y - 3), Cells(x + 1, y - 2)).Select
ActiveSheet.Paste
End If
Next i
End If
End If
Next
Next
Next
Next
End Sub

...全文