Удалить строки из документа слияния, если ячейка в Excel пуста - PullRequest
Новая
       25

Удалить строки из документа слияния, если ячейка в Excel пуста

0 голосов
/ 04 декабря 2018

Я создал mailmerge, используя VBA, который автоматически сохраняет каждую запись как свой собственный PDF.Единственная проблема, с которой я сталкиваюсь, состоит в том, что некоторые ячейки в Excel пусты и вытаскивают пустые.Документ, используемый для mailmerge, приведен в таблице, чтобы он выглядел лучше, а разделение полей слияния проще.Я хочу создать некоторый код, поэтому, если ячейка пуста, вместо того, чтобы пропустить пустое пространство, она вместо этого удаляет эту строку из таблицы в документе слияния.Я играл с MyDoc.tables (1) .Rows (). Удалить, но не могу заставить его работать.Мы ценим любую помощь

1 Ответ

0 голосов
/ 05 декабря 2018

Ваш код, очевидно, был получен из кода, который я выложил в другом месте, но был изменен без адекватного понимания Word VBA.Попробуйте: 

Sub RunMailMerge()
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim StrFolder As String, StrName As String, i As Long, j As Long, r As Long
Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
Const StrNoChr As String = """*./\:?|": StrName = "Certificate.docx"
StrFolder = ThisWorkbook.Path & Application.PathSeparator
If Dir(StrFolder & StrName) = "" Then Exit Sub
With wdApp
  'Disable alerts to prevent an SQL prompt
  .DisplayAlerts = wdAlertsNone
  'Display Word - change this to False once the code is running correctly
  .Visible = False
  'Open the mailmerge main document - set Visible:=True for testing
  Set wdDoc = .Documents.Open(Filename:=StrFolder & StrName, ReadOnly:=True, AddToRecentFiles:=False, Visible:=False)
  With wdDoc.MailMerge
    'Define the mailmerge type
    .MainDocumentType = wdFormLetters
    'Define the output
    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    'Connect to the data source
    .OpenDataSource Name:=strWorkbookName, ReadOnly:=True, LinkToSource:=False, AddToRecentFiles:=False, _
      Format:=wdOpenFormatAuto, Connection:="Provider=Microsoft.ACE.OLEDB.16.0;" & _
      "User ID=Admin;Data Source=strWorkbookName;Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
      SQLStatement:="SELECT * FROM `Sheet1$`", SubType:=wdMergeSubTypeAccess
    'Process all eligible records
    For i = 1 To .DataSource.RecordCount
      With .DataSource
        .FirstRecord = i
        .LastRecord = i
        .ActiveRecord = i
        'Exit if the field to be used for the filename is empty
        If Trim(.DataFields("PropertyRef")) = "" Then Exit For
        'StrFolder = .DataFields("Folder") & Application.PathSeparator
        StrName = .DataFields("PropertyRef")
      End With
      .Execute Pause:=False
      'Clean up the filename
      For j = 1 To Len(StrNoChr)
        StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
      Next
      StrName = "Certificate - " & Trim(StrName)
      'Delete table rows with $0.00 values
      With wdApp.ActiveDocument
        With .Tables(1)
          For r = 33 To 14 Step -1
            Select Case r
              Case 20, 28, 29
              Case Else: If Split(.Cell(r, 3).Range.Text, vbCr)(0) = "$0.00" Then .Rows(i).Delete
            End Select
          Next
        End With
        'Save as a PDF
        .SaveAs Filename:=StrFolder & StrName & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
        .Close SaveChanges:=False
      End With
    Next i
    'Disconnect from the data source
    .MainDocumentType = wdNotAMergeDocument
  End With
  'Close the mailmerge main document
  wdDoc.Close False
  'Restore the Word alerts
  .DisplayAlerts = wdAlertsAll
  'Exit Word
  .Quit
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Обратите внимание, что я предположил, что ваши «пустые» результаты будут выводиться как $ 0,00;вам нужно изменить эту часть кода, чтобы она соответствовала фактическому выводу.

...