Zugriff auf Office Clipboard mit VB.NE

  • VB.NET

Es gibt 13 Antworten in diesem Thema. Der letzte Beitrag () ist von -Franky-.

    Zugriff auf Office Clipboard mit VB.NE

    Hallo Community,

    Ich Programmiere zurzeit eine Excel-Anwendung in VB.NET. Darin ist eine Office-Zwischenablage-Funktion enthalten.
    Den zugehörigen VBA Code, den ich in Internet (stackoverflow.com/questions/64931911/how-to-empty-clipboard) gefunden und modifiziert habe, in mein Programm übertragen und z.T abgeändert.

    Hier ist mein modifizierter Vba-Code:

    Visual Basic-Quellcode

    1. Option Explicit
    2. Option Compare Text
    3. #If VBA7 Then
    4. Private Declare PtrSafe Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, _
    5. ByVal iChildStart As Long, ByVal cChildren As Long, _
    6. ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    7. Public Const mVBA7 As Long = 1
    8. #Else
    9. Private Declare Function AccessibleChildren Lib "oleacc" (ByVal paccContainer As Office.IAccessible, _
    10. ByVal iChildStart As Long, ByVal cChildren As Long, _
    11. ByRef rgvarChildren As Any, ByRef pcObtained As Long) As Long
    12. Public Const mVBA7 As Long = 0
    13. #End If
    14. Public Sub HClearOfficeClipBoard()
    15. Dim cmnB As Variant, IsVis As Boolean, j As Long, Arr As Variant, Status As Variant
    16. Dim k As Long
    17. Dim objClipboard As Variant
    18. On Error GoTo ErrH
    19. objClipboard = Application.ClipboardFormats
    20. 'Wenn die Zwischenablage leer ist, wird alles unterbrochen.
    21. If objClipboard(1) = -1 Then
    22. MsgBox "Zwischenablage ist leer. Es gibt keine Elemente in der Zwischenablage zum Löschen", vbExclamation
    23. Set objClipboard = Nothing
    24. Exit Sub
    25. End If
    26. 'Zustand von Office-Zwischenablage feststellen
    27. Status = Application.DisplayClipboardWindow
    28. Arr = Array(4, 7, 2, 0) '4 und 2 für 32 bit, 7 und 0 für 64 bit
    29. Set cmnB = Application.CommandBars("Office Clipboard")
    30. IsVis = cmnB.Visible
    31. If Not IsVis Then
    32. cmnB.Visible = True
    33. DoEvents
    34. End If
    35. For j = 1 To Arr(0 + mVBA7)
    36. k = Choose(j, 0, 3, 0, 3, 0, 3, 1)
    37. Call AccessibleChildren(cmnB, k, 1, cmnB, 1)
    38. ' AccessibleChildren cmnB, Choose(j, 0, 3, 0, 3, 0, 3, 1), 1, cmnB, 1 'Alle löschen
    39. ' AccessibleChildren cmnB, Choose(j, 0, 3, 0, 3, 0, 3, 0), 1, cmnB, 1 'Alle einfügen
    40. Next
    41. cmnB.accDoDefaultAction CLng(Arr(2 + mVBA7))
    42. 'Fenster von Office-Zwischenablage wiederherstellen
    43. Application.CommandBars("Office Clipboard").Visible = IsVis
    44. MsgBox "Erfolreich abgeschlossen. Inhalt von Office-Zwischenablage ist gelöscht", vbOKOnly, "OFFICE-ZWISCHENABLAGE"
    45. ErrH:
    46. If Err > 0 Then
    47. MsgBox "Fehler beim Löschen " & Err.Description, vbOKOnly, "OFFICE-ZWISCHENABLAGE"
    48. 'Zustand von Office-Zwischenablage wiederherstellen
    49. With Application
    50. .DisplayClipboardWindow = Status
    51. End With
    52. End If
    53. Set cmnB = Nothing
    54. End Sub


    Übrigens der Code funktioniert einwandfrei unter Excel 2016 und Excel 2019 32bit + 64bit -Version.

    Nun zum VB.NET:

    In Visual Basic habe ich ein neues "Windows Forms-Anwendung Projekt" erstellt, um den in VB.NET übersetzten Code zu testen.
    Form1 mit Zwei Buttons, Button1 schließt die Anwendung, Button2 führt die Sub HClearOfficeClipBoard(), die in Modul1 integriert ist aus.

    Hier ist der VB.NET-Code:

    VB.NET-Quellcode

    1. Imports System.Runtime.InteropServices
    2. Imports Accessibility
    3. Imports Microsoft.Office.Interop.Excel
    4. Module Module1
    5. Public ExApp As Object = Nothing
    6. Private Declare Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As IAccessible, _
    7. ByVal iChildStart As Long, ByVal cChildren As Long, _
    8. ByVal rgvarChildren As Object, ByRef pcObtained As Long) As Long
    9. Public Const mVBA7 As Long = 1
    10. Public Sub HClearOfficeClipBoard()
    11. Dim cmnB As Object, IsVis As Boolean, j As Long, Arr() As Long
    12. Dim k As Long, objClipboard As Object
    13. ' Hiermit wird der Verweis auf Excel-Instanz ermöglicht
    14. If Is_Excel_Running() = False Then
    15. MsgBox("Excel ist nicht gestartet. Bitte starten Sie Excel und versuchen Sie erneut")
    16. Exit Sub
    17. End If
    18. objClipboard = ExApp.ClipboardFormats
    19. 'Wenn die Zwischenablage leer ist, wird alles unterbrochen.
    20. If objClipboard(1) = -1 Then
    21. MsgBox("Zwischenablage ist leer. Es gibt keine Elemente in der Zwischenablage zum Löschen", MsgBoxStyle.Exclamation)
    22. ReleaseExcelObject(objClipboard)
    23. Exit Sub
    24. End If
    25. Arr = {4, 7, 2, 0} '4 und 2 für 32 bit, 7 und 0 für 64 bit
    26. cmnB = ExApp.CommandBars("Office Clipboard")
    27. Try
    28. IsVis = cmnB.Visible
    29. If Not IsVis Then
    30. cmnB.Visible = True
    31. End If
    32. For j = 1 To Arr(0 + mVBA7)
    33. k = Choose(j, 0, 3, 0, 3, 0, 3, 1)
    34. AccessibleChildren(cmnB, k, 1, cmnB, 1) 'Diese Zeile verursacht Fehler
    35. Next
    36. cmnB.accDoDefaultAction(CLng(Arr(2 + mVBA7)))
    37. ExApp.CommandBars("Office Clipboard").Visible = IsVis
    38. Catch ex As Exception
    39. MsgBox("FEHLER: " & ex.ToString)
    40. Finally
    41. ReleaseExcelObject(cmnB)
    42. ReleaseExcelObject(objClipboard)
    43. ReleaseExcelObject(ExApp)
    44. End Try
    45. End Sub
    46. Private Function Is_Excel_Running() As Boolean
    47. Dim Result As Boolean = Nothing
    48. Try
    49. Dim P As Process() = Process.GetProcessesByName("EXCEL")
    50. Dim CountLength As Integer = P.Length
    51. If CountLength <> 0 Then
    52. 'Excel ist bereits gestartet wir hängen uns in Excel-Instanz.
    53. ExApp = CType(Marshal.GetActiveObject("Excel.Application"), Application)
    54. 'wenn excel sichtbar
    55. If ExApp.Visible Then
    56. Result = True
    57. Else
    58. Result = False
    59. End If
    60. End If
    61. Catch e As Exception
    62. If Not ExApp Is Nothing Then
    63. ExApp = Nothing
    64. End If
    65. Result = False
    66. End Try
    67. Return Result
    68. End Function
    69. Private Sub ReleaseExcelObject(ByVal sender As Object)
    70. If (Not (sender) Is Nothing) Then
    71. Try
    72. Do Until _
    73. Marshal.ReleaseComObject(sender) <= 0
    74. Loop
    75. Catch
    76. Finally
    77. sender = Nothing
    78. End Try
    79. End If
    80. End Sub
    81. End Module



    Wenn ich die Sub ausführe, erhalte ich stets den Fehler:

    PInvokeStackImbalance wurde erkannt.
    Message: Ein Aufruf an die PInvoke-Funktion "WindowsApplication2!WindowsApplication1.Module1::AccessibleChildren" hat das Gleichgewicht des Stapels gestört.
    Wahrscheinlich stimmt die verwaltete PInvoke-Signatur nicht mit der nicht verwalteten Zielsignatur überein.
    Überprüfen Sie, ob die Aufrufkonvention und die Parameter der PInvoke-Signatur mit der nicht verwalteten Zielsignatur übereinstimmen.

    Von dem, was ich in div. Foren gefunden habe, war leider nichts hilfreich.

    Ich vermute, dass die Signatur von API-Funktion [AccessibleChildren Lib "oleacc.dll"] nicht stimmt.

    Hat jemand eine Ahnung, wie ich den Fehler beseitigen kann?

    Vielen Dank im Voraus für eure Bemühungen.

    *Topic verschoben* - Marcus Gräfe
    CodeTags korrigiert ~VaporiZed

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „VaporiZed“ ()

    Hi

    Jupp, Deine API Deklaration ist nicht korrekt. Zum einen, alle Long (VBA, VB6) werden in .NET zu Integer. paccContainer würde ich entsprechend für ein Interface marshallen "MarshalAs(UnmanagedType.Interface)". rgvarChildren ist ein Pointer auf ein Array der Structure VARIANT, nicht verwechseln mit dem Datentyp Variant in VBC oder VBA. Den müsste man ebenfalls entsprechend marshallen.
    ​ [out] rgvarChildren Type: VARIANT* [b]Pointer to an array of VARIANT structures[/b] that receives information about the container's children. If the vt member of an array element is VT_I4, then the lVal member for that element is the child ID. If the vt member of an array element is VT_DISPATCH, then the pdispVal member for that element is the address of the child object's IDispatch interface.
    Mfg -Franky-
    Hallo -Franky-,
    Danke für die Antwort.
    Ich bin Hobbyprogrammierer und habe sehr wenig Erfahrung über API's. Marshallen? Weiß ich gar nichts darüber.
    Ich habe in pinvoke.net pinvoke.net/default.aspx/oleacc.accessiblechildren folgende Signatur über accessiblechildren (oleacc) gefunden.

    Quellcode

    1. VB .NET Signature:
    2. Declare Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As IAccessible, ByVal iChildStart As Integer, ByVal cChildren As Integer, <[Out]()> ByVal rgvarChildren() As Object, ByRef pcObtained As Integer) As UInteger
    3. or
    4. <DllImport("oleacc.dll")> _
    5. Function AccessibleChildren(ByVal paccContainer As IAccessible, ByVal iChildStart As Integer, ByVal cChildren As Integer, <[Out]()> ByVal rgvarChildren() As Object, ByRef pcObtained As Integer) As UInteger
    6. End Function

    Mit den Anmerkungen:
    Meiner Meinung nach sollte der Rückgabewert ein signed Integer (oder int in c#) und kein UInteger oder uint sein.

    Ich würde mich sehr freuen, wenn Du mir hilfst den Code anzupassen.

    Freundliche Grüße

    ErfinderDesRades schrieb:

    Ist "Office.Clipboard" was anderes
    Das Office Clipboard ist so was wie ein Ringpuffer, der die letzten 24 Kopiervorgänge speichert, während das "normale" Clipboard immer nur das letzte Ereignis puffert.

    Keine Ahnung, wofür man das benötigt, aber es wurde mit Office 2007 als großer Fortschritt verkauft.
    Verwendet habe ich es noch nie.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Hallo ErfinderDesRades,
    Hallo petaod,

    Ich weiß, dass in .Net Clipboard-Klasse gibt. Ich bin der gleichen Meinung wie ihr.
    Office Clipboard ist definitiv nicht besser.
    Im Gegenteil sie verursacht Fehler, wenn sie mehr als mit 24 Kopiergänger belegt ist.
    Es geht darum, dass die Office Clipboard geleert wird, damit sie keinen Fehler macht.

    Ich rechne mit eurer Hilfe.

    Freundliche Grüße, 1978Lazigo
    Hallo Dksksm,
    danke vielmals.
    Leider funktioniert das bis Office 2013
    inzwischen habe ich die Deklaration von "accessiblechildren" geändert und die Variablen entsprechend angepasst.
    Der Code sieht nun so aus.

    VB.NET-Quellcode

    1. Declare Function AccessibleChildren Lib "oleacc.dll" (ByVal paccContainer As IAccessible, _
    2. ByVal iChildStart As Integer, ByVal cChildren As Integer, _
    3. <[Out]()> ByVal rgvarChildren() As Object, _
    4. ByRef pcObtained As Integer) As Integer
    5. Public ExApp As Object = Nothing
    6. Public Const mVBA7 As Integer = 1
    7. Public Sub HClearOfficeClipBoard()
    8. Dim objClipboard As Object, Arr() As Integer
    9. Dim IsVis As Boolean, j As Integer, k As Integer
    10. Dim cmnB As IAccessible = Nothing
    11. ' Hiermit wird der Verweis auf Excel-Instanz ermöglicht
    12. If Is_Excel_Running() = False Then
    13. MsgBox("Excel ist nicht gestartet. Bitte starten Sie Excel und versuchen Sie erneut")
    14. Exit Sub
    15. End If
    16. objClipboard = ExApp.ClipboardFormats
    17. 'Wenn die Zwischenablage leer ist, wird alles unterbrochen.
    18. If objClipboard(1) = -1 Then
    19. MsgBox("Zwischenablage ist leer. Es gibt keine Elemente in der Zwischenablage zum Löschen", MsgBoxStyle.Exclamation)
    20. Exit Sub
    21. End If
    22. Try
    23. 'Problemabschnitt Anfang
    24. Arr = {4, 7, 2, 0} '4 und 2 für 32 bit, 7 und 0 für 64 bit
    25. cmnB = ExApp.CommandBars("Office Clipboard")
    26. Dim childs() As Object = New Object((cmnB.accChildCount) - 1) {} '?????
    27. 'childs ??????
    28. IsVis = cmnB.Visible
    29. If Not IsVis Then
    30. cmnB.Visible = True
    31. End If
    32. For j = 1 To Arr(0 + mVBA7)
    33. k = Choose(j, 0, 3, 0, 3, 0, 3, 1)
    34. AccessibleChildren(cmnB, k, cmnB.accChildCount - 1 ???, childs???, 1)
    35. ' AccessibleChildren cmnB, Choose(j, 0, 3, 0, 3, 0, 3, 1), 1, cmnB, 1 'Alle löschen
    36. ' AccessibleChildren cmnB, Choose(j, 0, 3, 0, 3, 0, 3, 0), 1, cmnB, 1 'Alle einfügen
    37. Next
    38. cmnB.accDoDefaultAction(CInt(Arr(2 + mVBA7)))
    39. 'Problemabschnitt Ende
    40. 'Fenster von Office-Zwischenablage wiederherstellen
    41. ExApp.CommandBars("Office Clipboard").Visible = IsVis
    42. MsgBox("Erfolreich abgeschlossen. Inhalt von Office-Zwischenablage ist gelöscht", MsgBoxStyle.OkOnly, "OFFICE-ZWISCHENABLAGE")
    43. Catch ex As Exception
    44. MsgBox("Fehler beim Löschen " & ex.ToString, MsgBoxStyle.OkOnly, "OFFICE-ZWISCHENABLAGE")
    45. End Try
    46. End Sub

    Ich konzentriere mich jetzt nur noch auf dem Problemabschnitt.

    VB.NET-Quellcode

    1. 'Problemabschnitt Anfang
    2. Arr = {4, 7, 2, 0} '4 und 2 für 32 bit, 7 und 0 für 64 bit
    3. cmnB = ExApp.CommandBars("Office Clipboard")
    4. Dim childs() As Object = New Object((cmnB.accChildCount) - 1) {} '?????
    5. 'childs ??????
    6. IsVis = cmnB.Visible
    7. If Not IsVis Then
    8. cmnB.Visible = True
    9. ' objXlS.DoEvents()
    10. End If
    11. For j = 1 To Arr(0 + mVBA7)
    12. k = Choose(j, 0, 3, 0, 3, 0, 3, 1)
    13. AccessibleChildren(cmnB, k, cmnB.accChildCount - 1 ???, childs???, 1)
    14. ' AccessibleChildren cmnB, Choose(j, 0, 3, 0, 3, 0, 3, 1), 1, cmnB, 1 'Alle löschen
    15. ' AccessibleChildren cmnB, Choose(j, 0, 3, 0, 3, 0, 3, 0), 1, cmnB, 1 'Alle einfügen
    16. Next
    17. cmnB.accDoDefaultAction(CInt(Arr(2 + mVBA7)))
    18. 'Problemabschnitt Ende

    Ich weiß es nicht, welche Werte als das dritte (cChildren) und vierte (rgvarChildren()) -Argument an die Funktion übergeben werden.

    Danke für die Unterstützung und ein schönes Wochenende.
    Hi

    Ich komm gerade nicht dazu da was zu testen. Im dritten Parameter der API müsste einfach ein ObjectArray in der Größe von cChildren - 1 übergeben werden. Im letzten Parameter wird ein Wert in eine Variable geschrieben und nicht festgelegt. Wenn die API = S_Ok zurück gibt, dann sollte im ObjectArray, laut MSDN, entweder ein Wert (VT_I4) sein oder ein Interface (VT_Dispatch) sein. Dein Imports Accessibility dürfte auch nicht richtig sein. Wenn dann den von Imports Microsoft.Office.Core.
    Mfg -Franky-
    Hi

    Hatte mal ein wenig Zeit da was zu testen. Funktioniert zumindest mit meiner Excelversion.
    Spoiler anzeigen

    VB.NET-Quellcode

    1. Option Strict On
    2. Option Explicit On
    3. Imports Microsoft.Office.Core
    4. Imports Microsoft.Office.Interop
    5. Imports System.Runtime.InteropServices
    6. Public Class Form1
    7. Private Const S_OK As Integer = 0
    8. <DllImport("oleacc.dll", EntryPoint:="AccessibleChildren")>
    9. <PreserveSig> Private Shared Function AccessibleChildren(<[In], MarshalAs(UnmanagedType.Interface)> paccContainer As IAccessible,
    10. <[In]> iChildStart As Integer,
    11. <[In]> cChildren As Integer,
    12. <Out, MarshalAs(UnmanagedType.LPArray)> rgvarChildren As Object(),
    13. <Out> ByRef pcObtained As Integer) As Integer
    14. End Function
    15. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    16. Dim ExcelApp As Excel.Application = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
    17. If CType(ExcelApp.ClipboardFormats(1), Integer) = -1 Then
    18. Debug.Print("Zwischenablage ist leer.")
    19. Exit Sub
    20. End If
    21. Dim bolStatus As Boolean = ExcelApp.DisplayClipboardWindow
    22. Dim ExcelCommandBar As CommandBar = ExcelApp.CommandBars("Office Clipboard")
    23. Dim bolIsVisible As Boolean = ExcelCommandBar.Visible
    24. If Not bolIsVisible Then ExcelCommandBar.Visible = True
    25. Dim intRet As Integer
    26. Dim intChilderen As Integer = 1
    27. Dim oRet As Object() = New Object(intChilderen - 1) {}
    28. Dim oIAccessible As IAccessible = CType(ExcelCommandBar, IAccessible)
    29. Dim arrChoose As Integer() = New Integer() {0, 3, 0, 3, 0, 3, 1}
    30. For j As Integer = 0 To 3
    31. If AccessibleChildren(oIAccessible, arrChoose(j), intChilderen, oRet, intRet) = S_OK Then
    32. If intRet = intChilderen Then
    33. If Marshal.IsComObject(oRet(intRet - 1)) Then
    34. oIAccessible = CType(oRet(intRet - 1), IAccessible)
    35. End If
    36. End If
    37. End If
    38. Next
    39. Debug.Print(oIAccessible.accName(2))
    40. Debug.Print(oIAccessible.accDefaultAction(2))
    41. oIAccessible.accDoDefaultAction(2)
    42. 'ExcelCommandBar.Visible = False
    43. 'ExcelApp.DisplayClipboardWindow = bolStatus
    44. End Sub
    45. End Class

    Mfg -Franky-
    Hallo -Franky-,
    vielen lieben Dank und ein großes Lob für diesen hervorragenden Code.
    Beim Testen hat der Coder bei mir diesen Fehler verursacht.
    "System.ArgumentException: Der Wert liegt außerhalb des erwarteten Bereichs." Das war die Zeile 52.
    Nach den kleinen Korrekturen des Codes, Funktioniert jetzt auch mit meiner Excelversion.
    Ich habe folgende Berichtigungen vorgenommen.
    Für den Fehler war nicht die Zeile 52 verantwortlich, sondern weite oben, die Zeile 42. Die ich dann so

    VB.NET-Quellcode

    1. For j As Integer = 0 To 6

    geändert habe.

    Die Zeilen 52, 53 und 55 habe ich entsprechend angepasst.

    VB.NET-Quellcode

    1. Debug.Print(oIAccessible.accName(0))
    2. Debug.Print(oIAccessible.accDefaultAction(0))
    3. oIAccessible.accDoDefaultAction(0)

    Die Variable ExcelApp sollte als Object deklariert und den Wert "Nothing" zugewiesen werden, um den Fehler beim Testen zu vermeiden, wenn Excel nicht gestartet ist. Nicht vergessen! "Option Strict On" auszukommentieren. "Option Strict On" lässt kein spätes Binden zu. Der Block würde dann so aussehen.

    VB.NET-Quellcode

    1. Dim ExcelApp As Object = Nothing
    2. Try
    3. ExcelApp = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
    4. Catch ex As Exception
    5. If ExcelApp Is Nothing Then
    6. Debug.Print("Excel läuft nicht.")
    7. Exit Sub
    8. End If
    9. End Try


    Nochmals vielen Dank und Grüße an Bremen.

    1978lazigo schrieb:

    Die Variable ExcelApp sollte als Object deklariert und den Wert "Nothing" zugewiesen werden, um den Fehler beim Testen zu vermeiden, wenn Excel nicht gestartet ist. Nicht vergessen! "Option Strict On" auszukommentieren. "Option Strict On" lässt kein spätes Binden zu. Der Block würde dann so aussehen.

    Das eine schlechte Idee "Option Strict On" auszukommentieren. Ersetze "Dim ExcelApp As Object = Nothing" durch "Dim ExcelApp As Excel.Application = Nothing" und dann musst "Option Strict On" auch nicht auskommentieren. Die restlichen Sachen die Du angesprochen hast, sind wohl darauf zurückzuführen das Du wohl ein 64bit Office verwendest, da müssen ja andere Werte für die Schleife und den Button verwendet werden. Ich hab hier eine 32bit Office zum testen verwendet. Die beiden Debug.Print am Ende kannst rausnehmen, die waren nur zum testen ob ich auch den richtigen Button erwischt habe.
    Mfg -Franky-

    Neu

    -Franky- schrieb:

    Das eine schlechte Idee "Option Strict On" auszukommentieren. Ersetze "Dim ExcelApp As Object = Nothing" durch "Dim ExcelApp As Excel.Application = Nothing" und dann musst "Option Strict On" auch nicht auskommentieren.


    Hallo -franky-
    Du hast mit "Option Strict On" recht. Ich habe die Änderung wieder zurückgenommen und den Code etwas modifiziert. Beim Testen habe ich festgestellt, dass die folgende Methode den falschen Wert herausgibt, wenn man den ersten Eintrag in Clip Board löscht. Das Ergebnis ist immer -1, Obwohl noch mehrere Inhalte in Clip Board vorhanden sind.

    VB.NET-Quellcode

    1. If CType(ExcelApp.ClipboardFormats(1), Integer) = -1 Then
    2. Debug.Print("Zwischenablage ist leer.")
    3. Exit Sub
    4. End If

    Das Programm in Abhängigkeit von der Excel Version 32bit/64bit laufen zulassen war keine gute Idee. Obwohl das Programm mit Excel 2016 32bit fehlerfrei gelaufen ist, verursachte mit Excel 2019 32bit Fehler. Die 64bit-Version vom Programm lief mit Excel 2016/2019 64bit fehlerfrei. Ich weiss es nicht, wie sich das Programm mit Excel 2021 32bit/64bit aufführt. Vielleicht kann Jemand ja das testen und das Ergebnis hier teilen.
    Hier ist der geänderte Code.

    VB.NET-Quellcode

    1. Option Strict On
    2. Option Explicit On
    3. Imports Microsoft.Office.Core
    4. Imports Microsoft.Office.Interop
    5. Imports System.Runtime.InteropServices
    6. Public Class Form1
    7. Private Const S_OK As Integer = 0
    8. <DllImport("oleacc.dll", EntryPoint:="AccessibleChildren")>
    9. <PreserveSig()> Private Shared Function AccessibleChildren(<[In](), MarshalAs(UnmanagedType.Interface)> ByVal paccContainer As IAccessible,
    10. <[In]()> ByVal iChildStart As Integer,
    11. <[In]()> ByVal cChildren As Integer,
    12. <Out(), MarshalAs(UnmanagedType.LPArray)> ByVal rgvarChildren As Object(),
    13. <Out()> ByRef pcObtained As Integer) As Integer
    14. End Function
    15. Private Sub Button1_Click_1(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
    16. Dim ExcelApp As Excel.Application = Nothing
    17. Try
    18. ExcelApp = CType(Marshal.GetActiveObject("Excel.Application"), Excel.Application)
    19. 'Wenn Excel als Leiche in Speicher geblieben ist
    20. If ExcelApp.Visible = False Then Exit Sub
    21. Catch ex As Exception
    22. If ExcelApp Is Nothing Then
    23. 'Debug.Print("Excel läuft nicht.")
    24. Exit Sub
    25. End If
    26. End Try
    27. 'Das ist leider fehlerhaft. Lösch man den ersten Eintrag in der Zwischenablage
    28. 'dann ist der Wert immer -1 obwohl nocht weitere Inhalte
    29. 'vorhanden sind.
    30. If CType(ExcelApp.ClipboardFormats(1), Integer) = -1 Then
    31. 'Debug.Print("Zwischenablage ist leer.")
    32. 'Exit Sub
    33. End If
    34. Dim bolStatus As Boolean = ExcelApp.DisplayClipboardWindow
    35. Dim ExcelCommandBar As CommandBar = ExcelApp.CommandBars("Office Clipboard")
    36. Dim bolIsVisible As Boolean = ExcelCommandBar.Visible
    37. If Not bolIsVisible Then ExcelCommandBar.Visible = True
    38. ' Erst den Code für 32 Bit Version laufen lassen
    39. ' Wenn 32 Bit Code-Block Fehler verursacht
    40. ' Dann mit 64 Bit Code-Block weitermachen.
    41. '32 Bit CodeBlock -ANFANG-
    42. Dim intRet32 As Integer
    43. Dim intChilderen32 As Integer = 1
    44. Dim oRet32 As Object() = New Object(intChilderen32 - 1) {}
    45. Dim oIAccessible32 As IAccessible = CType(ExcelCommandBar, IAccessible)
    46. Dim arrChoose32 As Integer() = New Integer() {0, 3, 0, 3, 0, 3, 1}
    47. For j As Integer = 0 To 3
    48. If AccessibleChildren(oIAccessible32, arrChoose32(j), intChilderen32, oRet32, intRet32) = S_OK Then
    49. If intRet32 = intChilderen32 Then
    50. If Marshal.IsComObject(oRet32(intRet32 - 1)) Then
    51. oIAccessible32 = CType(oRet32(intRet32 - 1), IAccessible)
    52. End If
    53. End If
    54. End If
    55. Next
    56. Try
    57. 'Debug.Print(oIAccessible32.accName(2))
    58. 'Debug.Print(oIAccessible32.accDefaultAction(2))
    59. oIAccessible32.accDoDefaultAction(2)
    60. MessageBox.Show("DER INHALT DER OFFICE-ZWISCHENABLAGE IST GELÖSCHT", "EXCEL 32 BIT")
    61. ExcelCommandBar.Visible = bolIsVisible
    62. ExcelApp.DisplayClipboardWindow = bolStatus
    63. Exit Sub
    64. 'Wenn Ausnahmefall
    65. Catch ex As Exception
    66. 'MessageBox.Show("FEHLER : " & vbCr & ex.ToString & vbCrLf, "EXCEL 32 BIT")
    67. End Try
    68. '32 Bit Block -ENDE-
    69. '64 Bit Block -ANFANG-
    70. Dim intRet As Integer
    71. Dim intChilderen As Integer = 1
    72. Dim oRet As Object() = New Object(intChilderen - 1) {}
    73. Dim oIAccessible As IAccessible = CType(ExcelCommandBar, IAccessible)
    74. Dim arrChoose As Integer() = New Integer() {0, 3, 0, 3, 0, 3, 1}
    75. For j As Integer = 0 To 6
    76. If AccessibleChildren(oIAccessible, arrChoose(j), intChilderen, oRet, intRet) = S_OK Then
    77. If intRet = intChilderen Then
    78. If Marshal.IsComObject(oRet(intRet - 1)) Then
    79. oIAccessible = CType(oRet(intRet - 1), IAccessible)
    80. End If
    81. End If
    82. End If
    83. Next
    84. Try
    85. ' Wenn der Zustand von Button "Alle löschen" > 1 ist
    86. ' Zwischenablage hat Einträge
    87. If CInt(oIAccessible.accState(CInt(0))) > 1 Then
    88. oIAccessible.accDoDefaultAction(0)
    89. MessageBox.Show("DER INHALT DER OFFICE-ZWISCHENABLAGE IST GELÖSCHT", "EXCEL 64 BIT")
    90. End If
    91. ExcelCommandBar.Visible = bolIsVisible
    92. ExcelApp.DisplayClipboardWindow = bolStatus
    93. Catch ex As Exception
    94. MessageBox.Show("FEHLER : " & vbCr & ex.ToString & vbCrLf, "EXCEL 64 BIT")
    95. End Try
    96. '64 Bit Block -ENDE-
    97. ExcelApp = Nothing
    98. End Sub
    99. End Class

    Freundliche Grüße

    Neu

    Hi

    Ich kann da wenig zu beitragen da ich mich mit den ganzen Officezeug noch nie beschäftigt habe. Was ich aber vermeide, wenn es irgendwie geht, einen Try/Catch-Block zu verwenden. In Deinem Fall würde ich mal schauen ob die verwendete Office Version eine 32 oder 64bit Version ist und dann den entsprechenden Zweig aufrufen. Irgendwie wird sich das ja auslesen lassen.

    1978lazigo schrieb:

    Obwohl das Programm mit Excel 2016 32bit fehlerfrei gelaufen ist, verursachte mit Excel 2019 32bit Fehler

    Du schreibst aber auch nicht welchen Fehler. Wahrscheinlich bei accDoDefaultAction. Durchaus möglich das für arrChoose eine andere Reihenfolge für diese Officeversion benötigt wird oder accDoDefaultAction einen anderen Wert. Mit Debug.Print(oIAccessible32.accName(x)) kannst Dir ja zumindest die Caption des Button ausgeben lassen und schauen ob Du bei dem richtigen Button gelandet bist.
    Mfg -Franky-