Workbook上的代码_打开影响工作表上图像的初始视图

时间:2015-04-27 09:44:27

标签: excel image vba excel-vba

在打开工作簿时,我已将Worksheet.EnableCalculation属性设置为多个工作表的手册。在这个过程中,我还改变了每张纸上2个形状的大小(使一个图像变大,一个变小)。这些形状也分配了宏。为了增加更多的混淆,一张工作表可以在打开工作簿时完成,其余工作表则没有。好的纸张并不总是相同的纸张,我无法弄清楚那张纸张与其他纸张的不同之处。并不是说它在保存时是活跃的。

这很好但是在打开工作簿时查看工作表时,这些形状以及工作表上的所有其他形状(也用作宏按钮)似乎已在工作表上移动了位置(向上和向左)。但是,只需放大/缩小按钮就会显示在正确的位置。

我添加了代码以在Workbook_Open事件期间设置缩放以设置缩放,但这并不会阻止此异常显示。将缩放放入Workbook_SheetActivate也不会影响问题

它对工作簿没有任何明显的影响,并且一旦手动将缩放应用于每个受影响的工作表就不会出现问题,但是当它打开时它看起来不太好。

Private Sub Workbook_Open()

' ***** STOPS automatic formular updating
' x - Defined Cell Names  Lock_LABEL
' x - Image               Lock_ON    Lock_OFF

Application.ScreenUpdating = False  ' do not see screen updating

Sheets("5_Angebot").Select

    ' Turn automatic forular updating OFF
    ActiveSheet.EnableCalculation = False

    ' Make ON lock Small
    ActiveSheet.Shapes.Range(Array("Lock_ONN")).Select  ' x
    Selection.ShapeRange.Height = 28.3464566929

    ' Make OFF lock Big
    ActiveSheet.Shapes.Range(Array("Lock_OFF")).Select  ' x
    Selection.ShapeRange.Height = 46.7716535433

    ' Label
    Range("ANLock_LABEL").Select                        ' x
    ActiveCell.FormulaR1C1 = "Auto Update is OFF"
    Selection.HorizontalAlignment = xlLeft
    With ActiveCell.Characters(Start:=15, Length:=4).Font
        .FontStyle = "Fett"
        .Size = 10
        .Color = -16776961
    End With
    Range("B1").Select

    Sheets("5_Auftragsb").Select

    ' Turn automatic forular updating OFF
    ActiveSheet.EnableCalculation = False

    ' Make ON lock Small
    ActiveSheet.Shapes.Range(Array("Lock_ONN")).Select  ' x
    Selection.ShapeRange.Height = 28.3464566929

    ' Make OFF lock Big
    ActiveSheet.Shapes.Range(Array("Lock_OFF")).Select  ' x
    Selection.ShapeRange.Height = 46.7716535433

    ' Label
    Range("AULock_LABEL").Select                        ' x
    ActiveCell.FormulaR1C1 = "Auto Update is OFF"
    Selection.HorizontalAlignment = xlLeft
    With ActiveCell.Characters(Start:=15, Length:=4).Font
        .FontStyle = "Fett"
        .Size = 10
        .Color = -16776961
    End With
    Range("B1").Select

    Sheets("5_Abschluss").Select

    ' Turn automatic forular updating OFF
    ActiveSheet.EnableCalculation = False

    ' Make ON lock Small
    ActiveSheet.Shapes.Range(Array("Lock_ONN")).Select  ' x
    Selection.ShapeRange.Height = 28.3464566929

    ' Make OFF lock Big
    ActiveSheet.Shapes.Range(Array("Lock_OFF")).Select  ' x
    Selection.ShapeRange.Height = 46.7716535433

    ' Label
    Range("ABLock_LABEL").Select                        ' x
    ActiveCell.FormulaR1C1 = "Auto Update is OFF"
    Selection.HorizontalAlignment = xlLeft
    With ActiveCell.Characters(Start:=15, Length:=4).Font
        .FontStyle = "Fett"
        .Size = 10
        .Color = -16776961
    End With
    Range("B1").Select

    Sheets("7_FAX_KWagen").Select

    ' Turn automatic forular updating OFF
    ActiveSheet.EnableCalculation = False

    ' Make ON lock Small
    ActiveSheet.Shapes.Range(Array("Lock_ONN")).Select  ' x
    Selection.ShapeRange.Height = 28.3464566929

    ' Make OFF lock Big
    ActiveSheet.Shapes.Range(Array("Lock_OFF")).Select  ' x
    Selection.ShapeRange.Height = 46.7716535433

    ' Label
    Range("KWLock_LABEL").Select                        ' x
    ActiveCell.FormulaR1C1 = "Auto Update is OFF"
    Selection.HorizontalAlignment = xlLeft
    With ActiveCell.Characters(Start:=15, Length:=4).Font
        .FontStyle = "Fett"
        .Size = 10
        .Color = -16776961
    End With
    Range("B1").Select

    ' Turn automatic forular updating OFF
    ActiveSheet.EnableCalculation = False
    Range("B1").Select

    MsgBox "                     Hallo " & vbNewLine & vbNewLine & _
           "   Automatic updating is currently" & vbNewLine & _
           "                   turned off"

     ' Set Zoom on all sheets
    Dim ws As Worksheet

    For Each ws In Worksheets
        ws.Select
        ActiveWindow.Zoom = 120
    Next ws

    Sheets("3_Data Form").Select

    Application.ScreenUpdating = True  ' see screen updating

End Sub

2 个答案:

答案 0 :(得分:1)

我没有解决任何问题,只是制作了更简洁的代码版本。

Private Sub Workbook_Open()

' ***** STOPS automatic formular updating

' x - Defined Cell Names  Lock_LABEL
' x - Image               Lock_ON    Lock_OFF
Dim ShName(3, 1) As String
ShName(0, 0) = "5_Angebot"
    ShName(0, 1) = "ANLock_LABEL"
ShName(1, 0) = "5_Auftragsb"
    ShName(1, 1) = "AULock_LABEL"
ShName(2, 0) = "5_Abschluss"
    ShName(2, 1) = "ABLock_LABEL"
ShName(3, 0) = "7_FAX_KWagen"
    ShName(3, 1) = "KWLock_LABEL"
Dim ws As Worksheet
Application.ScreenUpdating = False                                        ' do not see screen updating
For Each ws In ActiveWorkbook.Worksheets
    ws.Select
    ActiveWindow.Zoom = 120                                               ' your zoom, seems unnecessary
    '.Range("B2").Select                                                  ' this one really isn't necessary
    Cells(ActiveWindow.SplitRow + 1, ActiveWindow.SplitColumn + 1).Select ' fancy way instead of B2, selects cell after frozen panels, still unnecessary
Next

For i = 0 To UBound(ShName(, 0))                                          ' not sure about this UBound, it should be the fancy way of 3
Set ws = Sheets(ShName(i, 0))
With ws
    .EnableCalculation = False                                            ' Turn automatic forular updating OFF
    .Shapes.Range(Array("Lock_ONN")).ShapeRange.Height = 28.3464566929    ' Make ON lock Small
    .Shapes.Range(Array("Lock_OFF")).ShapeRange.Height = 46.7716535433    ' Make OFF lock Big
    With .Range(ShName(i, 1))                                             ' Label     ' I'm not sure about this one, should work anyway; the dot might not be necessary
        .FormulaR1C1 = "Auto Update is OFF"
        .HorizontalAlignment = xlLeft
        With .Characters(Start:=15, Length:=4).Font
            .FontStyle = "Fett"
            .Size = 10
            .Color = -16776961
        End With
    End With
End With
Next i
MsgBox "                     Hallo " & vbNewLine & vbNewLine & _
           "   Automatic updating is currently" & vbNewLine & _
           "                   turned off"
Sheets("3_Data Form").Select
Application.ScreenUpdating = True                                         ' see screen updating
End Sub

答案 1 :(得分:1)

好的,没有完全解决问题,但已经找到了解决问题的方法。

我在代码中添加了第二个缩放。

看起来当操作缩放编码时,它只会影响尚未设置在缩放值上的纸张,这就是为什么随着屏幕看起来正常而打开哪些纸张的原因。当它改变两次时,它有效地导致它们全部被“改变”,从而解决了屏幕更新故障。

它现在可以使用但是要知道它只是一个绑带。