本人剛剛學習寫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
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/271701.html
標籤：VBA
上一篇：跪求大神C語言轉換為VB，謝謝