运行重复宏时显示消息框的VBA Excel代码

我的问题：当B11:Q22范围内的单元格值低于单元格K5定义的值时，我需要添加一个警告消息框。但是

我有2张工作表，表1（“重量”）是活动表。表2（“基准日期”）是隐藏的表

基本上，我的代码的工作方式是：

打开工作簿时，会出现一条消息，要求在工作表1的单元格B3中输入正确的项目编号

当工作表1中的单元格B3发生变化时，它会调用模块1上的宏，该宏会定期： A.将数据保存为pdf格式 B打开另一个excel文件并保存工作表1中的关键数据，然后关闭该文件 C根据B11:Q22中的数据调整表1中的图表比例

所需解决方案： 我需要优先权，当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

抱歉，其他代码在此工作簿中：

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

---

必须指出表1代码不完整。它至少错过了一个

结束if

，我不知道该放在哪里。

nextime

声明在哪里？抱歉！我误解了你的问题(