在vba(word)中调整图像大小时可重复崩溃

时间:2013-11-08 16:50:26

标签: vba ms-word

当我一起运行几个子程序时,我不断遇到可重复的崩溃。崩溃,我的意思是我得到一个" Microsoft Word已停止响应"消息,它关闭。深入研究这个问题导致我对问题的解决方式变得更加困惑。

我将代码删除到它的核心并将其发布在下面(而Template徽标只是一个93x93px的PNG)。这是我发现的。此代码在发布时运行时崩溃。如果我在'使用ourLogo'放置一个断点,然后按go,它就可以工作。如果我单步执行代码,它不会崩溃。如果我评论图像大小调整,它的工作原理。如果我注释掉块在insert insertInfo的末尾删除边框(并保持调整大小),它就可以工作。

Public newDoc As Document

Public Sub main()
    Dim saveName As String, savePath As String

    'Set up opening the file
    saveName = "Output_TEST.docx"
    savePath = ThisDocument.Path & "\"
    FindIt = Dir(savePath & saveName)

    Set newDoc = Nothing
    On Error Resume Next 'Check if the document is open already
        Set newDoc = Documents(saveName)
    On Error GoTo 0

    If Not newDoc Is Nothing Then 'Close the document if it's open
        newDoc.Close False
    End If

    Set newDoc = Documents.Add 'Write to a new Document (we'll save later)

    Call insertInfo
    Call insertHeader

    newDoc.SaveAs2 (savePath & saveName)
End Sub

Private Sub insertInfo()
    Dim headerTable As Table, myRange As Range

    newDoc.Range(0, 0).InsertAfter "Machine Specifications"
    Set myRange = newDoc.Range(0, 0)
    Set headerTable = newDoc.Tables.Add(newDoc.Words(3), 3, 2, wdWord9TableBehavior, wdAutoFitFixed)

    headerTable.Cell(1, 1).Range.Text = "Data:"
    headerTable.Cell(1, 2).Range.Text = "Probing data:"
    headerTable.Cell(2, 1).Range.Text = "Machine Number:"
    headerTable.Cell(2, 2).Range.Text = "Probe Head:"
    headerTable.Cell(3, 1).Range.Text = "Formula1"
    headerTable.Cell(3, 2).Range.Text = "Formula2"

    'WHY DO YOU CAUSE IT TO CRASH!?!?
    With headerTable
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
    End With

End Sub

Private Sub insertHeader()
    Dim newHeader As Range, headerTable1 As Table, ourLogo As InlineShape

    Set newHeader = newDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range
    Set headerTable1 = newDoc.Tables.Add(newHeader, 2, 3, wdWord9TableBehavior, wdAutoFitFixed)
    Call headerTable1.Cell(1, 1).Merge(headerTable1.Cell(2, 1))

    Set ourLogo = headerTable1.Cell(1, 1).Range.InlineShapes.AddPicture(FileName:="C:\temp\Template_logo.png", LinkToFile:=False, SaveWithDocument:=True)

    'WHY ARE YOU CRASHING????
    With ourLogo
        .Width = 40
        .Height = 40
    End With

    headerTable1.Columns(1).SetWidth ColumnWidth:=36.8, RulerStyle:=wdAdjustNone
    headerTable1.Columns(2).SetWidth ColumnWidth:=208.6, RulerStyle:=wdAdjustNone
    headerTable1.Columns(3).SetWidth ColumnWidth:=228, RulerStyle:=wdAdjustNone

    headerTable1.Cell(1, 2).Range.Text = "Logo"
    headerTable1.Cell(2, 2).Range.Text = "Address"
    headerTable1.Cell(1, 3).Range.Text = "Report"
    headerTable1.Cell(2, 3).Range.Text = Date

    With headerTable1
        .Borders(wdBorderTop).LineStyle = wdLineStyleNone
        .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
        .Borders(wdBorderBottom).LineStyle = wdLineStyleNone
        .Borders(wdBorderRight).LineStyle = wdLineStyleNone
        .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
        .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
    End With

End Sub

与此同时,我只是在文字之外调整图片并保存...但我仍然在这个问题上摸不着头脑。我不确定这是我的错误还是Word的问题,但不管怎样,我都很想知道发生了什么。

我猜测的是,它将两张桌子组合在一起并且它不是那样的吗?我的另一个想法是,它试图在图像完全加载之前调整大小,但我的测试并没有指明这一点。任何人都有任何想法导致它?这是Word中的错误吗?

0 个答案:

没有答案