Данные пользовательской формы для заполнения определенных таблиц на листе

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

У нас НЕТ представления о макете ваших листов, но мы можем попытаться получить представление о том, что происходит, используя код:

Этот раздел, по-видимому, является частью, которую (я полагаю) вы изменяете, ссылаясь на соответствующую таблицу:

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

Давайте посмотрим, что вы здесь делаете, разбив пару строк:

Во-первых, ваш With/End With не имеет значения, вы здесь вообще не используете WS3. Они могут идти. Они не причиняют вреда, потому что ничего не делают. Все, что находится внутри этой оболочки, в любом случае относится ко всему, что относится к rng.

Что еще более важно, вы пишете в ячейки, используя rng.Parent.Cells(LastRow, X)

Итак, вы ссылаетесь на диапазон таблицы (называемый rng), , затем переходите к .Parent, который будет листом, на котором Table2 находится , а затем из ячейки A1 вы найдете ячейку, используя LastRow и x.

Теперь ранее LastRow проверяет лист WS3, чтобы найти последнюю использованную ячейку / строку, а не rng или Table2 - поэтому вы будете писать в строку на основе WS3 независимо от того, где rng сидит.

Если вы можете сообщить, ГДЕ Table1 и Table2 (какой лист, верхний левый адрес ячейки), я думаю, что я мог бы обновить это, но прямо сейчас я бы угадал.