无论出于何种原因，此代码都可用于某些图像，而对于其他图像，它只是将图像随意地放在工作表上，我不知道为什么。多次将其拖入工作表时，它也无法更改纵横比。
我尝试过将图片变量存储为什么的变种，但似乎没有任何效果。令人沮丧的是它的随机性。在代码的另一种变体上（单个图片没有循环），代码一天有效，然后第二天不再需要调整图像大小。我正在运行最新版本的Excel（365订阅）。
Private Sub Workbook_Open()
Dim incomingloc As String
Dim incoming As Object
Dim nameplateloc As String
Dim nameplate As Object
Dim connection As Object
Dim connectionLoc As String
Dim dispicloc As String
Dim dispic As Object
Dim count As Integer
Dim count2 As Integer
Dim count3 As Integer
If Sheets("White Card").Range("AY1").Value = "X" Then 'Checks to See if the Incoming Picture & Nameplate Have Been Imported Before
If Sheets("Disassembly").Range("AY1").Value = "X" Then 'Checks to see if the Connection Diagram Has Been Imported Before
If Sheets("Motor Pictures").Range("F1").Value = "X" Then 'Checks to see if the Disassembly Pictures Have Been Imported Before
'Do Nothing All Pictures Have Been Imported
Else '3rd Main If Statement (Imports the Disassembly Pictures Once the Incoming & Connnection Diagram Have Been Imported)
count = 1
count2 = 1
count3 = 1
dispicloc = Sheets("White Card").Range("AY3") & "\" & count & ".jpg"
If Dir(dispicloc) <> "" Then
Result = MsgBox("Do You Want to Import the Disassembly Pictures", vbYesNo + vbQuestion)
If Result = vbYes Then
Do While Dir(dispicloc) <> ""
If count Mod 2 = 0 Then
Set dispic = Sheets("Motor Pictures").Pictures.Insert(dispicloc)
With dispic
'Resize the Picture
.ShapeRange.LockAspectRatio = msoFalse
.Left = Sheets("Motor Pictures").Range("D" & count2).Left
.Top = Sheets("Motor Pictures").Range("D" & count2).Top
.Width = Sheets("Motor Pictures").Range("D" & count2 & ":E" & count2).Width
.Height = Sheets("Motor Pictures").Range("D" & count2 & ":D" & count2 + 1).Height
.Placement = 1
.PrintObject = True
End With
count2 = count2 + 4
Else
Set dispic = Sheets("Motor Pictures").Pictures.Insert(dispicloc)
With dispic
'Resize the Picture
.ShapeRange.LockAspectRatio = msoFalse
.Left = Sheets("Motor Pictures").Range("A" & count3).Left
.Top = Sheets("Motor Pictures").Range("A" & count3).Top
.Width = Sheets("Motor Pictures").Range("A" & count3 & ":B" & count3).Width
.Height = Sheets("Motor Pictures").Range("A" & count3 & ":A" & count3 + 1).Height
.Placement = 1
.PrintObject = True
End With
count3 = count3 + 4
End If
count = count + 1
dispicloc = Sheets("White Card").Range("AY3") & "\" & count & ".jpg"
Loop
Sheets("Motor Pictures").Range("F1").Value = "X"
Else
MsgBox "You Can Add The Motor Pictures Later Using the Associated Button", vbInformation
End If
Else
'No Disassembly Pictures Found Do Nothing
End If
End If 'Third Main If Statement
Else '(Second Main If Statement) If the Incoming Pictures Have Been Imported but Not the Connection Diagram Proceed With a Prompt for Connection Diagram
End If 'Second Main If Statement
Else '(1st Main If Statement) If the Incoming Picture And Namplate Haven't Been Added Then Proceed With That Prompt to Import Them
End If '1st Main If Statement
End Sub