VBA AppActivate Microsoft Excel エラー

The AppActivate statement requires the title of the title window. In any case, here's another approach. First, assign your workbook to an object variable, and then refer to that variable when you want to activate that workbook. For example, you can assign your workbook as follows...

Code:

    Dim Wkb As Workbook
    
    Set Wkb = ThisWorkbook

or

Code:

    Dim Wkb As Workbook
    
    Set Wkb = ActiveWorkbook

Then, to active the workbook...

Hope this helps!

Domenic,
Thanks for the feedback. I have tried several variations on AppActivate including appActivate thisworkbook.name which does not throw an error, but does not give me focus on thisworkbook. I have also tried something almost identical to what you suggested with creating an object and setting it to = thisworkbook then activating it. Unfortunately that does not bring focus back on thisworkbook either. Any other ideas?

Thanks again,
CN.

Both methods should work. However, I've just tested the line of code that shows the Print Setup dialog box in Excel 2016. The dialog box pops up, and a printer can be selected, but there's no OK button that can be selected. There's only a Cancel button, a greyed out Options button, and a Set as Default Printer button. Do you get the same thing? Maybe this is prevented the code from continuing?

I agree both methods should work. Unfortunately they are not. I just tested the same code with wdDialogFilePrintSetup line commented out, and it sets focus on the word doc then refuses to set focus on the Excel App, so I believe that is not the cause of the problem...

Try posting your complete code so that we can have a look at it...

Code:

Sub PrintMe()

Dim irow As Integer
Dim wdDoc As Word.Document
Dim sPath As String
Dim ccAmount As ContentControl
Dim ccDate As ContentControl
Dim ccPayee As ContentControl
Dim TreatyName As String
Dim rngTreatyNames As Range
Dim rngFound As Range
Dim iRowCheckPaperNeeded As Integer
Dim bPaperNeeded As Boolean
Dim wdApp As Word.Application

sPath = "O:\Accounting\STEVE\Misc\Blank Check.docm"
'sPath = "H:\Development\Check Printing\Blank Check.docm"
If TestIfFileISOpened.IsFileOpen(sPath) <> False Then
    If TestIfFileISOpened.IsFileOpen(sPath) = True Then
        MsgBox ("You must close the file " & sPath & " before you can run this program.  Please close it and start over.")
    Else
        MsgBox ("I cannot access the file " & sPath & " for some reason.  Please contact tech support for help.  Error Number: " & TestIfFileISOpened.IsFileOpen(sPath))
    End If
    Exit Sub
End If
Set wdDoc = GetWord(sPath, wdApp)

Set ccAmount = wdDoc.ContentControls(3)
Set ccPayee = wdDoc.ContentControls(5)
Set ccDate = wdDoc.ContentControls(2)
Set rngTreatyNames = Sheets("Treaty Names").Range("A1:A" & Sheets("Treaty Names").UsedRange.Rows.Count)

MsgBox ("Please choose the printer you wish to use.")
wdApp.Activate
wdDoc.Application.Dialogs(wdDialogFilePrintSetup).Show
'AppActivate ThisWorkbook.Name, 5 'This isnt working... not sure why... Can't seem to get focus back on Excel... I guess they will have to click on Excel... :(

'loop through each row on editable results... if there is a print (Y or y) and a sum of amount payable, then print the check... set CCAmount = sum of amount, set ccPayee = Row labels, and ccDate = today()
'First set First Treaty Name...
TreatyName = Sheets("Editable Results").Cells(5, "A")
bPaperNeeded = False


If checkPaperNeeded(6, Sheets("Editable Results").UsedRange.Rows.Count, rngTreatyNames) Then
    MsgBox ("Please put " & TreatyName & " stock in the printer.")
End If
For irow = 6 To Sheets("Editable Results").UsedRange.Rows.Count
    Set rngFound = rngTreatyNames.Find(Sheets("Editable Results").Cells(irow, "A"), , , xlWhole)
    If rngFound Is Nothing Then
        If Sheets("Editable Results").Cells(irow, "B") > 0 And UCase(Trim(Sheets("Editable Results").Cells(irow, "C"))) = "Y" Then
            ccAmount.Range.Text = Sheets("Editable Results").Cells(irow, "B")
            ccPayee.Range.Text = Sheets("Editable Results").Cells(irow, "A")
            ccDate.Range.Text = Date
            Call ModifyWordDoc.adjustCurrency(ccAmount, wdDoc)
            wdDoc.printout
        End If
    Else
        TreatyName = Sheets("Editable Results").Cells(irow, "A")
        If checkPaperNeeded(irow + 1, Sheets("Editable Results").UsedRange.Rows.Count, rngTreatyNames) Then
            MsgBox ("Please put " & TreatyName & " stock in the printer.")
        End If
    End If
    

Next irow

wdDoc.Saved = True
wdDoc.Close
wdApp.Quit
        

End Sub

Private Function checkPaperNeeded(iRowStart As Integer, iRowEnd As Integer, rngTreatyNames As Range) As Boolean
Dim i As Integer
Dim rngFound As Range
checkPaperNeeded = False
For i = iRowStart To iRowEnd
    If UCase(Trim(Sheets("Editable Results").Cells(i, "C"))) = "Y" Then
        checkPaperNeeded = True
        Exit For
    End If
    Set rngFound = rngTreatyNames.Find(Sheets("Editable Results").Cells(i, "A"), , , xlWhole)
    If Not rngFound Is Nothing Then
        Exit For
    End If
Next i
End Function

Code:

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

        ' Another error occurred.
        Case Else
            IsFileOpen = errnum
    End Select

End Function