Question

我一直在寻找高潮和低潮，并得出了一些结果，但没有达到我想要达到的目标。

我有两种不同的用户形式，一种用于创建采购订单，另一种用于创建变更订单。根据所选的用户窗体，一旦输入数据并使用了命令按钮，我就需要数据来填充表1（用于来自POUserform的采购订单）或表2（用于来自COUserform的变更订单）。两个表都在同一工作表上。这甚至有可能吗？

下面是我当前拥有的代码-无论我运行的是哪种用户窗体，它始终希望填充相同的表。

请注意，用户表1和用户表2的代码完全相同，但“表1”和“表2”除外。

Private Sub SendCOButton_Click()

Dim xSht As Worksheet
Dim xFileDlg As FileDialog
Dim xFolder As String
Dim xYesorNo As Integer
Dim xOutlookObj As Object
Dim xEmailObj As Object
Dim xUsedRng As Range

Dim rng As Range
Set rng = ActiveSheet.ListObjects("Table2").Range
Dim LastRow As Long

Dim iRow As Long
  Dim WS1 As Worksheet, WS2 As Worksheet, WS3 As Worksheet
  Set WS1 = Worksheets("Original Contracts")
  Set WS2 = Worksheets("Purchase Order Template")
  Set WS3 = Worksheets("Project Snapshot")

'find first empty row in database
iRow = WS1.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

LastRow = WS3.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1

If WorksheetFunction.CountIf(WS3.Range("A1:A5000", WS3.Cells(LastRow, 1)), 
Me.CONo.Value) > 0 Then
    MsgBox "Duplicate Change Order Number!", vbCritical
    Exit Sub
End If


'copy the data to the database
'use protect and unprotect lines,
'     with your password
'     if worksheet is protected

With WS1
End With

With WS2
  .Range("H1").Value = Me.CONo.Value
  .Range("B6").Value = Me.COTradeList.Value
  .Range("H6").Value = Me.COAttn.Value
  .Range("B7").Value = Me.COEmail.Value
  .Range("H7").Value = Me.COPhone.Value
  .Range("H16").Value = Me.COPrice1.Value
End With

With WS3
  rng.Parent.Cells(LastRow, 1).Value = CONo.Value
  rng.Parent.Cells(LastRow, 2).Value = COTradeList.Value
  rng.Parent.Cells(LastRow, 3).Value = COItems.Value
  rng.Parent.Cells(LastRow, 4).Value = CODescription1.Value
  rng.Parent.Cells(LastRow, 5).Value = COPrice1.Value
  rng.Parent.Cells(LastRow, 6).Value = CODateIssued.Value
End With

Set xSht = Worksheets("Purchase Order Template")
Set xFileDlg = Application.FileDialog(msoFileDialogFolderPicker)

If xFileDlg.Show = True Then
   xFolder = xFileDlg.SelectedItems(1)
Else
   MsgBox "You must specify a folder to save the PDF into." & vbCrLf & 
   vbCrLf & "Press OK to exit this macro.", vbCritical, "Must Specify 
   Destination Folder"
 Exit Sub
End If
xFolder = xFolder + "\" & Worksheets("Purchase Order 
Template").Range("B9").Value & " - PO No. " & Worksheets("Purchase Order 
Template").Range("G1").Value & " - " & Worksheets("Purchase Order 
Template").Range("B6").Value & ".pdf"

'Check if file already exist
If Len(Dir(xFolder)) > 0 Then
   xYesorNo = MsgBox(xFolder & " already exists." & vbCrLf & vbCrLf & "Do 
   you want to overwrite it?", _
                  vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
If xYesorNo = vbYes Then
    Kill xFolder
Else
    MsgBox "if you don't overwrite the existing PDF, I can't continue." _
                & vbCrLf & vbCrLf & "Press OK to exit this macro.", 
vbCritical, "Exiting Macro"
    Exit Sub
End If
If Err.Number <> 0 Then
    MsgBox "Unable to delete existing file.  Please make sure the file is 
not open or write protected." _
                & vbCrLf & vbCrLf & "Press OK to exit this macro.", 
vbCritical, "Unable to Delete File"
    Exit Sub
  End If
End If

Set xUsedRng = xSht.UsedRange
If Application.WorksheetFunction.CountA(xUsedRng.Cells) <> 0 Then
'Save as PDF file
xSht.ExportAsFixedFormat Type:=xlTypePDF, FileName:=xFolder, 
Quality:=xlQualityStandard

'Create Outlook email
Set xOutlookObj = CreateObject("Outlook.Application")
Set xEmailObj = xOutlookObj.CreateItem(0)
Set xSht = Worksheets("Purchase Order Template")
With xEmailObj
    .Display
    .To = Worksheets("Purchase Order Template").Range("B7").Value
    .CC = ""
    .BCC = ""
    .Subject = Worksheets("Purchase Order Template").Range("E9").Value & " 
  - " & "PO# " & Worksheets("Purchase Order Template").Range("G1").Value & 
  " - " & Worksheets("Purchase Order Template").Range("B6").Value
    .Attachments.Add xFolder
    If DisplayEmail = False Then
        '.Send
        End If
    End With
 Else
  MsgBox "The active worksheet cannot be blank"
  Exit Sub
 End If

  Unload Me
End Sub

Answer 1

我们不知道您的工作表的布局，但是我们可以尝试使用代码来了解正在发生的事情：

此部分似乎是（我认为）要更改为引用相应表的部分：

length = len(array)
array[randint(0, length)]

然后，在代码后面，使用以下命令将数据写到工作表中：

Dim rng As Range
Set rng = ActiveSheet.ListObjects("Table2").Range

让我们通过分解以下几行来看看您在做什么：

首先，您的With WS3 rng.Parent.Cells(LastRow, 1).Value = CONo.Value rng.Parent.Cells(LastRow, 2).Value = COTradeList.Value rng.Parent.Cells(LastRow, 3).Value = COItems.Value rng.Parent.Cells(LastRow, 4).Value = CODescription1.Value rng.Parent.Cells(LastRow, 5).Value = COPrice1.Value rng.Parent.Cells(LastRow, 6).Value = CODateIssued.Value End With无关紧要，您这里根本没有使用WS3。他们可以走了。他们没有任何伤害，因为他们什么都不做。无论如何，该包装器中的所有内容都是与With/End With相关的所有内容。

更重要的是，您正在使用rng

写入单元格

因此，您参考表的范围（称为rng.Parent.Cells(LastRow, X)），然后转到它的rng ，这将是.Parent位于< em>，然后从单元格A1 中找到您使用Table2和x的单元格。

现在，LastRow将检查WS3表以查找最后使用的单元格/行，而不是LastRow或rng-因此，您将基于WS3写入行，无论Table2位于何处。

如果您可以建议rng和Table1是（哪张纸，左上角单元格地址）在哪里，我想我可能可以更新它，但是现在我正在猜测。

用户表单数据以填充工作表上的特定表

1 个答案: