Question

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

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

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

当工作簿打开时，会出现一条消息，要求在表单1的单元格B3中输入正确的项目编号。
当工作表1中的单元格B3发生变化时，它会在模块1上调用一个宏，该宏周期性地：一个。将数据保存为pdf 湾打开另一个Excel文件并保存工作表1中的关键数据并关闭该文件 C。根据B11：Q22

需要解决方案： 我需要优先级，当B3更改时（模块1宏）开始以PDF格式自动保存，但如果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

运行重复宏时出现的消息框的VBA Excel代码

0 个答案: