堆栈内存溢出
  繁体   English   中英

如何转换在 Excel 2013 上编写的 VBA 代码，以便它可以在 Excel 2016 上运行？

[英]How can I transform my VBA code that was written on Excel 2013 so that it would work on Excel 2016?

 原文  2021-02-21 07:49:14  7   0    excel/ vba

问题描述

    Private Sub Image2_Click()

End Sub

Private Sub cmdProduct_Change()

End Sub

Private Sub AvailableStocks_Click()

End Sub

Private Sub cmb_Product_Change()


Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Product_Master")


If Me.cmb_Product.Value = "" Or Me.cmb_Type.Value = "" Then Me.txt_Rate.Value = ""

Dim rate As Double   ' Or String, not sure what your data is.
On Error Resume Next
rate = WorksheetFunction.VLookup(Me.cmb_Product, sh.Range("B:D"), 2, False)
On Error GoTo 0
Me.txt_Rate.Value = rate



On Error Resume Next
rate = WorksheetFunction.VLookup(Me.cmb_Product, sh.Range("B:D"), 3, False)
On Error GoTo 0
Me.txt_Rate.Value = rate


End Sub

Private Sub cmb_Type_Change()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Product_Master")


If Me.cmb_Product.Value = "" Or Me.cmb_Type.Value = "" Then Me.txt_Rate.Value = ""
   
If Me.cmb_Type.Value = "Sale" Then
    Me.txt_Rate.Value = Application.WorksheetFunction.VLookup(Me.cmb_Product, sh.Range("B:D"), 2, 0)
ElseIf Me.cmb_Type.Value = "Purchase" Then
     Me.txt_Rate.Value = Application.WorksheetFunction.VLookup(Me.cmb_Product, sh.Range("B:D"), 3, 0)
   
End If


End Sub

Private Sub CommandButton1_Click()
 Call Add_Product_list
 Call Show_Sale_Purchase_Data
 Call Show_Inventory
 Call Show_Numbers
    
End Sub

Private Sub CommandButton2_Click()


frm_ProductMaster.Show False
 
 


End Sub

Private Sub CommandButton3_Click()
ThisWorkbook.Save
MsgBox "Data Has been Saved"

End Sub

Private Sub CommandButton4_Click()
Call Show_Inventory
End Sub

Private Sub CommandButton5_Click()
Dim nwb As Workbook
Set nwb = Workbooks.Add

ThisWorkbook.Sheets("Inventory_Display").UsedRange.Copy nwb.Sheets(1).Range("A1")
End Sub

Private Sub CommandButton6_Click()

'''''''' Validation ''''''''''

If Me.cmb_Product.Value = "" Then
    MsgBox "Please selet the Product", vbCritical
    Exit Sub
End If



If IsNumeric(Me.txtQty) = False Then
    MsgBox "Please enter correct QTY", vbCritical
    Exit Sub
End If


If Me.cmb_Type.Value = "" Then
    MsgBox "Please selet the Type", vbCritical
    Exit Sub
End If

'''''''''''' Add Data
 Dim sh As Worksheet
 Set sh = ThisWorkbook.Sheets("Sale_Purchase")
 
 Dim lr As Long
 lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))
 
 sh.Range("A" & lr + 1).Value = lr
 sh.Range("B" & lr + 1).Value = Me.cmb_Product.Value
 sh.Range("C" & lr + 1).Value = Me.cmb_Type.Value
 sh.Range("D" & lr + 1).Value = Me.txtQty.Value
 sh.Range("E" & lr + 1).Value = Me.txt_Rate.Value
 
 sh.Range("F" & lr + 1).Value = Me.txt_Rate.Value * Me.txtQty.Value

If Me.cmb_Type.Value = "Purchase" Then
    sh.Range("G" & lr + 1).Value = "NA"
Else
sh.Range("G" & lr + 1).Value = (Me.txt_Rate.Value * Me.txtQty.Value) - Application.WorksheetFunction.VLookup(Me.cmb_Product, ThisWorkbook.Sheets("Product_Master").Range("B:D"), 3, 0) * Me.txtQty.Value
End If
 sh.Range("H" & lr + 1).Value = Me.txt_Date.Value
 
 
     
 ''''''''''' CLEAR BOXES
Me.cmb_Product.Value = ""
Me.cmb_Type.Value = ""
Me.cmb_Type.Value = ""
Me.txt_Rate.Value = ""


Call Show_Sale_Purchase_Data
Call Show_Inventory
Call Show_Numbers

MsgBox "Data has been added", vbInformation

 
 
     
     
     
End Sub

Private Sub CommandButton7_Click()

'''''''' Validation ''''''''''

If Me.cmb_Product.Value = "" Then
    MsgBox "Please selet the Product", vbCritical
    Exit Sub
End If



If IsNumeric(Me.txtQty) = False Then
    MsgBox "Please enter correct QTY", vbCritical
    Exit Sub
End If


If Me.cmb_Type.Value = "" Then
    MsgBox "Please selet the Type", vbCritical
    Exit Sub
End If

'''''''''''' Update Data
 Dim sh As Worksheet
 Set sh = ThisWorkbook.Sheets("Sale_Purchase")
 
 Dim lr As Long
 lr = Me.txt_id.Value
 
 sh.Range("A" & lr + 1).Value = lr
 sh.Range("B" & lr + 1).Value = Me.cmb_Product.Value
 sh.Range("C" & lr + 1).Value = Me.cmb_Type.Value
 sh.Range("D" & lr + 1).Value = Me.txtQty.Value
 sh.Range("E" & lr + 1).Value = Me.txt_Rate.Value
 
 sh.Range("F" & lr + 1).Value = Me.txt_Rate.Value * Me.txtQty.Value

If Me.cmb_Type.Value = "Purchase" Then
    sh.Range("G" & lr + 1).Value = "NA"
Else
sh.Range("G" & lr + 1).Value = (Me.txt_Rate.Value * Me.txtQty.Value) - Application.WorksheetFunction.VLookup(Me.cmb_Product, ThisWorkbook.Sheets("Product_Master").Range("B:D"), 3, 0) * Me.txtQty.Value
End If
 sh.Range("H" & lr + 1).Value = Me.txt_Date.Value
 
 
     
 ''''''''''' CLEAR BOXES
Me.cmb_Product.Value = ""
Me.cmb_Type.Value = ""
Me.cmb_Type.Value = ""
Me.txt_Rate.Value = ""
Me.txt_id.Value = ""


Call Show_Sale_Purchase_Data
Call Show_Inventory
Call Show_Numbers

MsgBox "Data has been updated", vbInformation

 
 
     
     
     

End Sub

Private Sub CommandButton8_Click()

Dim nwb As Workbook
Set nwb = Workbooks.Add

ThisWorkbook.Sheets("Sale_Purchase_Display").UsedRange.Copy nwb.Sheets(1).Range("A1")

End Sub

Private Sub Image4_Click()

End Sub

Private Sub Image10_Click()
Call Calendar.SelectedDate(Me.txt_Date)
End Sub

Private Sub Image11_Click()

Call Calendar.SelectedDate(Me.txt_StartDate)

End Sub

Private Sub Image3_Click()

Call Calendar.SelectedDate(Me.txt_EndDate)

End Sub

Private Sub TxtEndDate_Change()

End Sub



Private Sub Image5_Click()

End Sub

Private Sub Image6_Click()

End Sub

Private Sub Image8_Click()

End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)


 Me.txt_id.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 0)
 Me.cmb_Product.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 1)
 Me.txtQty.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 3)
 Me.cmb_Type.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 2)
 Me.txt_Rate.Value = Me.ListBox2.List(Me.ListBox2.ListIndex, 4)
 
 Me.txt_Date.Value = Format(Me.ListBox2.List(Me.ListBox2.ListIndex, 7), "D-MMM-YYYY")
 
 
 






End Sub

Private Sub OptionButton1_Click()
Call Show_Sale_Purchase_Data

End Sub

Private Sub OptionButton3_Click()
Call Show_Sale_Purchase_Data

End Sub

Private Sub OptionButton4_Click()
Call Show_Sale_Purchase_Data

End Sub



Private Sub txt_EndDate_Change()

End Sub

Private Sub UserForm_Initialize()

Me.txt_StartDate.Value = Format(Date, "D-MMM-YYYY")
Me.txt_EndDate.Value = Format(Date, "D-MMM-YYYY")
Me.txt_Date.Value = Format(Date, "D-MMM-YYYY")


'''''''''' Drop Down FOR TYPE
With Me.cmb_Type
        .AddItem ""
        .AddItem "Sale"
        .AddItem "Purchase"
End With
 
 Call Add_Product_list
 Call Show_Sale_Purchase_Data
 Call Show_Inventory
 Call Show_Numbers
 
End Sub


Sub Add_Product_list()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Product_Master")

Dim i As Integer

Me.cmb_Product.Clear
Me.cmb_Product.AddItem ""

For i = 2 To Application.WorksheetFunction.CountA(sh.Range("A:A"))
    Me.cmb_Product.AddItem sh.Range("B" & i)
Next i

End Sub

Sub Show_Sale_Purchase_Data()


Dim dsh As Worksheet
Dim sh As Worksheet

Set dsh = ThisWorkbook.Sheets("Sale_Purchase")
Set sh = ThisWorkbook.Sheets("Sale_Purchase_Display")

dsh.AutoFilterMode = False

dsh.Range("H:H").NumberFormat = "D-MMM-YYYY"

'''''''' PUTTING FILTER ''''''''
dsh.UsedRange.AutoFilter 8, ">=" & Me.txt_StartDate.Value, xlAnd, "<=" & Me.txt_EndDate.Value

If Me.OptionButton4.Value = True Then
    dsh.UsedRange.AutoFilter 3, "Purchase"
End If


If Me.OptionButton3.Value = True Then
    dsh.UsedRange.AutoFilter 3, "Sale"
End If

sh.UsedRange.Clear

dsh.UsedRange.Copy
sh.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats

dsh.AutoFilterMode = False



'''''''''''''''''' Display Data in Listbox

Dim lr As Long

lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))

If lr = 1 Then lr = 2

With Me.ListBox2
    .ColumnCount = 8
    .ColumnHeads = True
    .ColumnWidths = "0,190,70,70,70,70,70,70"
    .RowSource = sh.Name & "!A2:H" & lr

End With


End Sub
Sub Show_Inventory()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Inventory")

sh.Cells.Clear

ThisWorkbook.Sheets("Product_Master").Range("B:B").Copy sh.Range("A1")

sh.Range("B1").Value = "Purchase"
sh.Range("C1").Value = "Sale"
sh.Range("D1").Value = "Available Stock"
sh.Range("E1").Value = "Stock Value"

Dim lr As Long

lr = Application.WorksheetFunction.CountA(sh.Range("A:A"))


If lr > 1 Then

    sh.Range("B2").Value = "=SUMIFS(Sale_Purchase!D:D,Sale_Purchase!B:B,Inventory!A2,Sale_Purchase!C:C,""Purchase"")"
    sh.Range("C2").Value = "=SUMIFS(Sale_Purchase!D:D,Sale_Purchase!B:B,Inventory!A2,Sale_Purchase!C:C,""Sale"")"
    sh.Range("D2").Value = "=B2-C2"
    sh.Range("E2").Value = "=VLOOKUP(A2,Product_Master!B:C,2,FALSE) *D2"
    
    If lr > 2 Then
        sh.Range("B2:E" & lr).FillDown
    End If
    
    sh.Calculate
    
End If


sh.UsedRange.Copy
sh.UsedRange.PasteSpecial xlPasteValues

Dim inv_Display As Worksheet
Set inv_Display = ThisWorkbook.Sheets("Inventory_Display")

inv_Display.Cells.Clear

If Me.txtSearch.Value <> "" Then
sh.UsedRange.AutoFilter 1, "*" & Me.txtSearch.Value & "*"
End If
sh.UsedRange.Copy inv_Display.Range("A1")


'''''''''''''''''''''' show data

    lr = Application.WorksheetFunction.CountA(inv_Display.Range("A:A"))


If lr = 1 Then lr = 2



With Me.ListBox1
    .ColumnCount = 5
    .ColumnHeads = True
    .ColumnWidths = "150,0,0,80,0"
    .RowSource = inv_Display.Name & "!A2:E" & lr
End With



End Sub



Sub Show_Numbers()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Report")

sh.Range("C1").Value = Me.txt_StartDate.Value
sh.Range("C2").Value = Me.txt_EndDate.Value
sh.Calculate

Me.LblPurchase.Caption = sh.Range("C4").Value
Me.lbSale.Caption = sh.Range("C5").Value
Me.lblProfit.Caption = sh.Range("C6").Value
Me.lblInventory.Caption = sh.Range("C7").Value
Me.lblInventory1.Caption = sh.Range("C8").Value

End Sub

此代码是为库存管理系统编写的。 它对我来说运行完美，但是当我将它发送给我的同事时，他们会遇到图书馆问题，因为他们使用的是 Excel 2016。我如何确保它对他们有效。 有我可以使用的工具吗？ 我可以使用任何具体的参考吗？ 我尝试检查 MS Office 15.0 Object 库和 MS Excel 15.0 Object 库，但它们不可用。

0 个解决方案

暂无
暂无

声明:本站的技术帖子网页，遵循CC BY-SA 4.0协议，如果您需要转载，请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

相关问题 代码在VBA for Excel 2013中有效，但在Excel 2016中出错 Excel，Vba，单元格值，如何转换代码，如屏幕截图所示？ 我的VBA Excel代码在Mac Excel上运行，但不在Windows Excel 2016上运行 无法将MS Project 2013任务读入Excel 2016 VBA 如何让我的超链接工作？ （Excel，VBA） 新问题，定义字段/记录WAS为什么我不能在用Excel 2013编写的VBA程序中使用DAO Excel 2013中编写的Excel to PPT Automation VBA代码在Excel 2013中不起作用 如何使在32位Excel 2016上编写的宏在64位Excel 2016上工作 VBA代码在Excel 2013中工作正常，但在Excel 2016中给出错误-编译错误 如何将 Selenium 添加到 Excel VBA 2013？
相关标签
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM