Импорт изображений и изменение их размеров - PullRequest
0 голосов
/ 05 февраля 2019

По какой-либо причине этот код работает для некоторых изображений, а для других он просто выбрасывает изображение на рабочий лист в случайном месте, и я не могу понять, почему.Он также не может изменить соотношение сторон, когда несколько раз вытягивает его на листе.

Я пробовал варианты сохранения переменной изображения, но, похоже, ничего не работает.Расстраивающая часть - это случайность.В другом варианте кода (без цикла для отдельных изображений) код работал один день, а затем на следующий он больше не хочет изменять размер изображения.Я использую последнюю версию 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...