My Problem: 当B11:Q22范围内的单元格值低于单元格K5定义的值时,我需要添加一个警告消息框 . 但
我有2张工作表,第1张(“重量”)是活动表 . 表2(“基准日期”)是隐藏表
基本上我的代码的工作方式是:
-
当工作簿打开时,会出现一条消息,要求在工作表1的单元格B3中输入正确的项目编号 .
-
当工作表1中的单元格B3发生更改时,它会调用模块1上的宏,该模块定期执行:a . 将数据保存为pdf b . 打开另一个excel文件并保存工作表1中的关键数据并关闭该文件c . 根据B11:Q22中的数据调整表1中的图表比例
Solution required: 我需要优先级,在B3更改时开始自动保存为PDF(模块1宏),但如果B11:Q22范围内的任何单元格值低于单元格K5定义的值,则仍会立即显示消息框用户确认消息,继续使用模块1宏,直到范围中的下一个值低于K5
表1代码:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strPath2 As String
Dim wbkWorkbook2 As Workbook
If Target.Address = "$B$3" Then
response = MsgBox("Are You Sure this is the correct item number?", vbYesNo)
If response = vbNo Then
MsgBox ("Please input correct Item number")
Exit Sub
End If
'define paths and filenames
strPath2 = "Z:\Groups - Sunbeam\Operations\Production\Production Data\Trade Weights\BIB\BIB Trade Weight Summary.xlsm"
'open file
Set wbkWorkbook2 = Workbooks.Open(strPath2)
wbkWorkbook2.Worksheets("Sheet1").Rows("4:4").Select
Selection.Insert Shift:=xlDown
'close workbook 2
wbkWorkbook2.Close (True)
Sheets("Weight").Range("B9:Q22").ClearContents
Call Macro1
第1单元代码:
Sub Macro1()
Dim objCht As ChartObject
Dim sht As Worksheet ' Creates a variable to hold your Weight worksheet
Dim strPath2 As String
Dim wbkWorkbook2 As Workbook
Set sht = ThisWorkbook.Sheets("Weight") ' Sets the reference
Set sht1 = ThisWorkbook.Sheets("Base Data") ' Sets the reference
Application.DisplayAlerts = False
Application.ScreenUpdating = False
sht.Unprotect ("xxxx")
'define paths and filenames
strPath2 = "Z:\Groups - Sunbeam\Operations\Production\Production Data\Trade Weights\BIB\BIB Trade Weight Summary.xlsm"
'open file
Set wbkWorkbook2 = Workbooks.Open(strPath2)
'copy the raw average data values across to master excel file
ThisWorkbook.Sheets("Weight").Range("B5").Copy
wbkWorkbook2.Worksheets("Sheet1").Range("A4").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets("Weight").Range("I23").Copy
wbkWorkbook2.Worksheets("Sheet1").Range("Q4").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets("Weight").Range("J23").Copy
wbkWorkbook2.Worksheets("Sheet1").Range("R4").PasteSpecial Paste:=xlPasteValues
ThisWorkbook.Sheets("Weight").Range("K23").Copy
wbkWorkbook2.Worksheets("Sheet1").Range("S4").PasteSpecial Paste:=xlPasteValues
'close workbook 2
wbkWorkbook2.Close (True)
sht1.Visible = xlSheetHidden
sht.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Z:\Groups - Sunbeam\Operations\Production\Production Data\Trade Weights\BIB\Records\" & sht.Range("B3").Text & " " & sht.Range("G3").Text ' Remember to preceed Range with sht. to explicitly reference the range of your Weight worksheet
On Error Resume Next ' Continue with next line of code if we encounter an error
Application.OnTime Earliesttime:=nextTime, Procedure:="Macro1", Schedule:=False
On Error GoTo 0 ' Resume error-trapping
nextTime = Now + TimeSerial(0, 0, 10) ' Adds 10 seconds to Now
Application.OnTime Earliesttime:=nextTime, Procedure:="Macro1", Schedule:=True
timerIsRunning = True
For Each objCht In ActiveSheet.ChartObjects
With objCht.Chart
' Value (Y) Axis
With .Axes(xlValue)
.MaximumScale = sht1.Range("R14").Value
.MinimumScale = sht1.Range("P14").Value
.MajorUnit = sht1.Range("T14").Value
End With
End With
Next objCht
sht.Protect ("xxxx")
Application.DisplayAlerts = True ' Remember to enable alerts at the end of code
Application.ScreenUpdating = True
End Sub
道歉,其他代码在ThisWorkbook中:
Private Sub Workbook_Open()
Dim strPath2 As String
Dim wbkWorkbook2 As Workbook
Sheet1.Range("a1:af1").Select
ActiveWindow.Zoom = True
Sheets("Weight").Range("B9:Q22").ClearContents
MsgBox ("Please enter the correct 'Item Number' and press 'Enter'")
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next ' Continue with next line of code if we encounter an error
Application.OnTime Earliesttime:=nextTime, Procedure:="Macro1", Schedule:=False
On Error GoTo 0 ' Resume error-trapping
End Sub