Excel macro werkt niet meer onder win11

[yourservice]

Mijn macro in Excel werkte perfect onder Win10, nu ik (helaas) ben overgestapt op Win11 krijg ik ineens een foutmelding.





Ik gebruik dus Win11 met Office 365 en Excel.

Ik heb hier eerder een post gehad met deze vraag en ik ben heel erg goed geholpen, ik kan deze post niet meer terugvinden.

'Written: November 28, 2009
'Author: Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.

Function FindPrinter(ByVal PrinterName As String) As String

'This works with Windows 2000 and up

Dim Arr As Variant
Dim Device As Variant
Dim Devices As Variant
Dim Printer As String
Dim RegObj As Object
Dim RegValue As String
Const HKEY_CURRENT_USER = &H80000001

Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
RegObj.enumvalues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr

For Each Device In Devices
RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
Printer = Device & " on " & Split(RegValue, ",")(1)
If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then
FindPrinter = Printer
Exit Function
End If
Next


End Function

Sub PDFbriefpapier()

Dim bChoice As Boolean
bChoice = Application.Dialogs(xlDialogPrinterSetup).Show(ActivePrinter)
If Not bChoice Then
VBA.MsgBox "User cancelled"
Else
VBA.MsgBox ActivePrinter
End If

'
' PDFbriefpapier Macro
' Afdrukken als .pdf op blanco papier
'

' naam huidig werkblad opslaan

Dim strCurrentWorkBook As String
strCurrentWorkBook = ActiveWorkbook.Name ' stores the current active window

Dim strMyPrinter As String
strMyPrinter = FindPrinter("Microsoft Print to PDF")

Dim wbCurrent As Workbook
Set wbCurrent = ActiveWorkbook

' testfactuur openen, oude content verwijderen en weer vullen met de huidige factuur

Workbooks.Open Filename:= _
"D:\foldernaam\Correspondentie\Testfactuur.xlsx"
wbCurrent.Activate
Range("A1:F49").Select
Selection.Copy
Windows("Testfactuur.xlsx").Activate
ActiveSheet.Paste

' printgedeelte

Dim strCurrentPrinter As String
strCurrentPrinter = Application.ActivePrinter ' stores the current active (default) printer

Application.ActivePrinter = FindPrinter("Microsoft Print to PDF op Ne00:") ' change what is in quotes as per appropriate printer name in the Print Dialog Box

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False

Application.ActivePrinter = strCurrentPrinter 'Returns printer output to your default printer

ActiveWindow.Close savechanges:=False

Range("A1").Select 'haalt het geselecteerde gebied weer weg door naar A1 te gaan

End Sub

toon volledige bericht

[centr1no]

Ik heb in het verleden iets soortgelijks gehad bij een overgang naar Office 2016.
Het ActiveWorkbook leek te verspringen naar het (bij mij) nieuw gecreëerde bestand.
De oplossing lag geloof ik in het definiëren van het bron- en doelbestand voor de copy-paste.

Je zou kunnen proberen ActiveWorkbook te vervangen door ThisWorkbook.
Of door helemaal niet te activeren d.m.v. With-End WIth.
Of je workbook te definiëren met ActiveWorkbook.Name en daar rechtstreeks naar te verwijzen.

[yourservice]

centr1no schreef op zaterdag 19 november 2022 @ 12:13:

Je zou kunnen proberen ActiveWorkbook te vervangen door ThisWorkbook.

Gedaan, zonder resultaat.

Of door helemaal niet te activeren d.m.v. With-End WIth.

Deze begrijp ik niet, waar komt deze dan te staan?

Of je workbook te definiëren met ActiveWorkbook.Name en daar rechtstreeks naar te verwijzen.

Dat gebeurt toch al hier:
[...]

Bedankt centr1no, zie mijn opmerkingen.

[centr1no]

Vervang dit

' naam huidig werkblad opslaan

Dim strCurrentWorkBook As String
strCurrentWorkBook = ActiveWorkbook.Name ' stores the current active window

Dim strMyPrinter As String
strMyPrinter = FindPrinter("Microsoft Print to PDF")

Dim wbCurrent As Workbook
Set wbCurrent = ActiveWorkbook

' testfactuur openen, oude content verwijderen en weer vullen met de huidige factuur

Workbooks.Open Filename:= _
"D:\foldernaam\Correspondentie\Testfactuur.xlsx"
wbCurrent.Activate
Range("A1:F49").Select
Selection.Copy
Windows("Testfactuur.xlsx").Activate
ActiveSheet.Paste

toon volledige bericht

Voor dit:

' naam huidig werkblad opslaan

Dim strCurrentWorkBook As String
strCurrentWorkBook = ActiveWorkbook.Name
Dim strCurrentWorkSheet As String
strCurrentWorkSheet = ActiveSheet.Name
Dim strMyPrinter As String
strMyPrinter = FindPrinter("Microsoft Print to PDF")

' testfactuur openen, oude content verwijderen en weer vullen met de huidige factuur

Workbooks.Open Filename:= _
"D:\foldernaam\Correspondentie\Testfactuur.xlsx"

Workbooks(strCurrentWorkBook).Worksheets(strCurrentWorkSheet).Range("A2:F49").Copy _
Workbooks("Testfactuur.xlsx").Worksheets(1).Range("A1")

toon volledige bericht

[F_J_K]

Twintig jaar oude code (Windows 2000!) zal inderdaad op een gegeven moment stoppen te werken. Zie @centr1no als dat is wat je onderliggende gevraagde functie is

[MAX3400]

Let op: nieuws: Microsoft gaat VBA-macro's in Office toch blokkeren na gebruikerskritiek

Subtiele verwoording: ga je hele workflow & code maar eens herzien en "voldoen" aan de huidige eisen / functies van Office.

Er komt echt een moment dat iets ineens niet meer werkt en dat komt vaak op momenten dat je er eigenlijk geen tijd voor hebt

[centr1no]

MAX3400 schreef op maandag 21 november 2022 @ 19:19:
ga je hele workflow & code maar eens herzien en "voldoen" aan de huidige eisen / functies van Office.

Er komt echt een moment dat iets ineens niet meer werkt en dat komt vaak op momenten dat je er eigenlijk geen tijd voor hebt

Het betreft volgens mij nog steeds alleen van internet gedownloade bestanden.
Zelfs al zouden Office applicaties standaard macro's blokkeren dan kun je er als bedrijf nog steeds voor kiezen om dat intern wel toe te staan.

[MAX3400]

centr1no schreef op dinsdag 22 november 2022 @ 08:32:
[...]
Het betreft volgens mij nog steeds alleen van internet gedownloade bestanden.
Zelfs al zouden Office applicaties standaard macro's blokkeren dan kun je er als bedrijf nog steeds voor kiezen om dat intern wel toe te staan.

Ik kan je (helaas) vertellen dat in een aantal gevallen Office dusdanig is bijgewerkt, dat het ook "gewoon" geldt voor je eigen bestanden.

Zo is eerder dit jaar 64-bit VBA preference/verplicht geworden en zijn voornamelijk LongPtr, LongLong en PtrSafe getroffen. Je wil niet weten hoeveel plezier ik heb gehad om dit te moeten constateren en oplossen met klanten.

Dus, of het nou blokkeren van code is, blokkeren van bit-types, etc: het lijkt me gewoon raadzaam om eens per jaar of ieder geval bij "ineens problemen" niet te zoeken naar omwegen maar naar oplossingen.

[yourservice]

Bedankt voor de reacties. Op de 1 of andere manier gaat de functie dus niet de IF code in.

Als ik de hele Findprinter functie uitschakel (ooit erin gezet om te kijken op welke NE poort mijn printers staan) dan werkt het weer als vanouds. Met dus gewoon keihard:

Application.ActivePrinter = "Microsoft Print to PDF op Ne00:"

For Each Device In Devices
RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
Printer = Device & " on " & Split(RegValue, ",")(1)
If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then
FindPrinter = Printer
Exit Function
End If
Next