VBA from Word to Excel

做~自己de王妃 提交于 2021-01-27 19:20:31

问题


I'm having issues with some VBA code that lives in a Word Template. The intent is to have the code open an Excel book, reference to Sheet named "Log", and find a row based on the Word document's name. Once the name is matched, I want to change a cells value to "completed". Then save and close the Excel workbook. I have tried the code below which will open the correct work book, but wont update the cell to "Completed", I get an error:

Private Sub CommandButton1_Click()
'***********************************************************************************************
'Message box asking if you are sure you are ready to submit report for completion
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Are you sure you are ready to submitt this Smart Learning Report?"        ' Define message.
Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.
Title = "Submit SLR"    ' Define title.
Help = "DEMO.HLP"    ' Define Help file.
Ctxt = 1000    ' Define topic context.
    ' Display message.
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbNo Then    ' User chose Yes.
    MyString = "No"    ' Perform some action.
    Exit Sub
End If

'***********************************************************************************************
'File name to be used to update the status in the Log
Dim CONum As String

'File name to be used to save report as PDF
Dim PDF As String

CONum = ActiveDocument.FullName
PDF = Replace(CONum, ".docm", ".pdf")

'***********************************************************************************************
Application.ScreenUpdating = False
Application.DisplayAlerts = False

'***********************************************************************************************
'Open excel, find cell with matching Word document name (CONum) in column K, 
_and change the cell value in column J (-1) to COMPLETED, save and close excel when completed.
Dim excelApp As Excel.Application
Dim openExcel As Excel.Workbook

  Set excelApp = Excel.Application
  Set openExcel = excelApp.Workbooks.Open("C:\Users\ggonzales\Desktop\SLR's\GPT SLR Submission.xlsm")
  excelApp.Visible = True

With openExcel
    Dim CRow As Excel.Range
    Set CRow = Sheets("Log").Range("K:K").Find(What:=CONum,     LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
    If Not CRow Is Nothing Then
    CRow.Offset(, -1).Value = "COMPLETED"
    End If
ActiveWorkbook.Save 'Filename:=COFile, FileFormat:=52
ActiveWorkbook.Close
End With

'***********************************************************************************************
Application.ScreenUpdating = True
Application.DisplayAlerts = True

'***********************************************************************************************
'Delete Command Button so it does not show on the final report, _
and so no one can submit the same report twice.
For Each o In ActiveDocument.InlineShapes
   If o.OLEFormat.Object.Caption = "Complete & Submit Report" Then
        o.Delete
    End If
Next

'***********************************************************************************************
'Save a copy of the report as a PDF
ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        PDF, ExportFormat:= _
        wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument

'***********************************************************************************************
'Close and save report (Word Document)
ActiveDocument.Close SaveChanges:=True

End Sub

回答1:


You need Set for object variables:

Set CRow = Sheets("Log").Range("K:K").Find(What:=CONum, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)

Then you should test if the Find was successful. And you can use Offset here to simplify.

If Not CRow Is Nothing Then
    CRow.Offset(,1).Value = "COMPLETED"
End If

Note, you are not actually using the With...End With.

Revised code:

With openExcel
    Dim CRow As Excel.Range
    Set CRow = .Sheets("Log").Range("K:K").Find(What:=CONum, LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)

    If Not CRow Is Nothing Then
        CRow.Offset(,1).Value = "COMPLETED"
    End If

    .Save 'Filename:=COFile, FileFormat:=52
    .Close
End With


来源:https://stackoverflow.com/questions/59159890/vba-from-word-to-excel

标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!