VBA 32 Bit Code auf 64 Bit System

[StrammerMax]

Hallo zusammen, 

ich habe vor Jahren mal einen Code geschrieben / kopiert auf Windows 10 mit 32 Bit. 

Der Code hat einwandfrei funktioniert und tut es auf dem System noch immer. 
Dann wurden alle Rechner auf 64 Bit Windows 11 umgestellt und nun wirft der Code einen Fehler dass er nicht auf einem 64 Bit System ausgeführt werden kann. 

Kann man den Code so umschreiben, dass er wieder auf 64 Bit läuft (oder am besten auf beiden Systemen gleichzeitig)?

Code:

'*******************************
' // This code Sets the BackColor of
' // Pages on a Multipage Control
'*******************************
Option Explicit

'=============================
' // Private Declarations.
'=============================

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type LOGBRUSH
    lbStyle As Long
    lbColor As Long
    lbHatch As Long
End Type

Private Type BITMAPINFOHEADER '40 bytes
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biRUsed As Long
    biRImportant As Long
End Type

' A BITMAPINFO structure for bitmaps with no color palette.
Private Type BITMAPINFO_NoColors
    bmiHeader As BITMAPINFOHEADER
End Type

Private Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type

Private Type MemoryBitmap
    hdc As Long
    hbm As Long
    oldhDC As Long
    wid As Long
    hgt As Long
    bitmap_info As BITMAPINFO_NoColors
End Type

Private Declare Function CreateCompatibleDC Lib "gdi32" _
(ByVal hdc As Long) _
As Long

Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) _
As Long

Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long

Private Declare Function ReleaseDC Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hdc As Long) As Long

Private Declare Function DeleteDC Lib "gdi32" _
(ByVal hdc As Long) _
As Long

Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) _
As Long

Private Declare Function CreateDIBSection Lib "gdi32" _
(ByVal hdc As Long, pBitmapInfo As BITMAPINFO_NoColors, _
ByVal un As Long, ByVal lplpVoid As Long, _
ByVal handle As Long, ByVal dw As Long) _
As Long

Private Declare Function GetDIBits Lib "gdi32" _
(ByVal aHDC As Long, ByVal hBitmap As Long, ByVal _
nStartScan As Long, ByVal nNumScans As Long, _
lpBits As Any, lpBI As BITMAPINFO_NoColors, _
ByVal wUsage As Long) _
As Long

Private Declare Function SetRect Lib "user32" _
(lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, _
ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function SetBkMode Lib "gdi32.dll" _
(ByVal hdc As Long, ByVal nBkMode As Long) _
As Long

Private Declare Function CreateBrushIndirect Lib "gdi32" _
(lpLogBrush As LOGBRUSH) As Long

Private Declare Function FillRect Lib "user32" _
(ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal nIndex As Long) As Long

Private Const DIB_RGB_COLORS = 0&
Private Const BI_RGB = 0&
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const POINTSPERINCH As Long = 72

'=============================
' // Public Routines.
'=============================
Public Sub SetBackColor(Page As MSForms.Page, Color As Long)

    Dim sBMPFile As String
    sBMPFile = Environ("UserProfile") & "\Temp.bmp"
    Dim memory_bitmap As MemoryBitmap

    ' Create the memory bitmap.
    memory_bitmap = MakeMemoryBitmap _
    (Page)

    ' Draw on the bitmap.
    DrawOnMemoryBitmap memory_bitmap, Color

    ' Save the bmp.
    Call SaveMemoryBitmap(memory_bitmap, sBMPFile)

    ' load the bmp onto the page.
    Set Page.Picture = LoadPicture(sBMPFile)

    ' Delete the memory bitmap.
    DeleteMemoryBitmap memory_bitmap

    ' Delete BMP file.
    Kill sBMPFile

End Sub



'=============================
' // Private Routines.
'=============================

' Make a memory bitmap according to the MultiPage size.
Private Function MakeMemoryBitmap _
(Page As MSForms.Page) As MemoryBitmap

    Dim result As MemoryBitmap
    Dim bytes_per_scanLine As Long
    Dim pad_per_scanLine As Long
    Dim new_font As Long

    ' Create the device context.
    result.hdc = CreateCompatibleDC(0)


    ' Define the bitmap.
    With result.bitmap_info.bmiHeader
        .biBitCount = 32
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = Len(result.bitmap_info.bmiHeader)
        .biWidth = PTtoPX(Page.Parent.Parent.InsideWidth, 0)
        .biHeight = PTtoPX(Page.Parent.Parent.InsideHeight, 1)
        bytes_per_scanLine = ((((.biWidth * .biBitCount) + _
        31) \ 32) * 4)
        pad_per_scanLine = bytes_per_scanLine - (((.biWidth _
        * .biBitCount) + 7) \ 8)
        .biSizeImage = bytes_per_scanLine * Abs(.biHeight)
    End With

    ' Create the bitmap.
    result.hbm = CreateDIBSection( _
    result.hdc, result.bitmap_info, _
    DIB_RGB_COLORS, ByVal 0&, _
    ByVal 0&, ByVal 0&)

    ' Make the device context use the bitmap.
    result.oldhDC = SelectObject(result.hdc, result.hbm)

    ' Return the MemoryBitmap structure.
    result.wid = PTtoPX(Page.Parent.Parent.InsideWidth, 0)
    result.hgt = PTtoPX(Page.Parent.Parent.InsideHeight, 1)

    MakeMemoryBitmap = result

End Function

Private Sub DrawOnMemoryBitmap( _
memory_bitmap As _
MemoryBitmap, Color As Long _
)

   Dim LB As LOGBRUSH, tRect As RECT
   Dim hBrush As Long

   LB.lbColor = Color

   'Create a new brush
    hBrush = CreateBrushIndirect(LB)
    With memory_bitmap
       SetRect tRect, 0, 0, .wid, .hgt
    End With

    SetBkMode memory_bitmap.hdc, 2 'Opaque

    'Paint the mem dc.
    FillRect memory_bitmap.hdc, tRect, hBrush

End Sub

' Save the memory bitmap into a bitmap file.
Private Sub SaveMemoryBitmap( _
memory_bitmap As MemoryBitmap, _
ByVal file_name As String _
)

    Dim bitmap_file_header As BITMAPFILEHEADER
    Dim fnum As Integer
    Dim pixels() As Byte

    ' Fill in the BITMAPFILEHEADER.
    With bitmap_file_header
        .bfType = &H4D42   ' "BM"
        .bfOffBits = Len(bitmap_file_header) + _
        Len(memory_bitmap.bitmap_info.bmiHeader)
        .bfSize = .bfOffBits + _
        memory_bitmap.bitmap_info.bmiHeader.biSizeImage
    End With

    ' Open the output bitmap file.
    fnum = FreeFile
    Open file_name For Binary As fnum
    ' Write the BITMAPFILEHEADER.
    Put #fnum, , bitmap_file_header
    ' Write the BITMAPINFOHEADER.
    ' (Note that memory_bitmap.bitmap_info.bmiHeader.biHeight
    ' must be positive for this.)
    Put #fnum, , memory_bitmap.bitmap_info
    ' Get the DIB bits.
    ReDim pixels(1 To 4, _
    1 To memory_bitmap.wid, _
    1 To memory_bitmap.hgt)
    GetDIBits memory_bitmap.hdc, memory_bitmap.hbm, _
    0, memory_bitmap.hgt, pixels(1, 1, 1), _
    memory_bitmap.bitmap_info, DIB_RGB_COLORS
    ' Write the DIB bits.
    Put #fnum, , pixels
    ' Close the file.
    Close fnum

End Sub

' Delete the bitmap and free its resources.
Private Sub DeleteMemoryBitmap( _
memory_bitmap As MemoryBitmap _
)

    SelectObject memory_bitmap.hdc, memory_bitmap.oldhDC
    DeleteObject memory_bitmap.hbm
    DeleteDC memory_bitmap.hdc

End Sub

Private Function ScreenDPI(bVert As Boolean) As Long

    Static lDPI(1), lDC

    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If

    ScreenDPI = lDPI(Abs(bVert))

End Function

Private Function PTtoPX _
(Points As Single, bVert As Boolean) As Long

    PTtoPX = Points * ScreenDPI(bVert) / POINTSPERINCH

End Function

Danke

[schauan]

Hallöchen,

das wird sicher eine Fleißaufgabe. Im Prinzip musst Du folgendes auf 32 und 64 bit deklarieren
- API
- Typen
- Variablendeklarationen in Makros
- Verwendung von Long oder LongPtr
- ggf. Makroabschnitte differenzieren oder Code in zweierlei Makro's platzieren

Dazu nutzt man die bedingte Ausführung #IF #Then #Else #End If

z.B. für einige Apis könnte das so aussehen:

Code:

#If VBA7 And Win64 Then
    Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function EmptyClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
    Private Declare PtrSafe Function IsClipboardFormatAvailable Lib "User32.dll" (ByVal wFormat As Long) As Long
    Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
    Private Declare PtrSafe Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
    Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As Long
    Private Declare PtrSafe Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As LongPtr
  #Else
    Private Declare Function OpenClipboard Lib "User32.dll" (ByVal hwnd As Long) As Long
    Private Declare Function EmptyClipboard Lib "User32.dll" () As Long
    Private Declare Function CloseClipboard Lib "User32.dll" () As Long
    Private Declare Function IsClipboardFormatAvailable Lib "User32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function GetClipboardData Lib "User32.dll" (ByVal wFormat As Long) As Long
    Private Declare Function SetClipboardData Lib "User32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
    Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
    Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
    Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
    Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Any) As Long
  #End If

[RPP63]

Moin!
Nur ergänzend:

Dann wurden alle Rechner auf 64 Bit Windows 11 umgestellt

Das Problem hat absolut nichts mit der Windows-Version zu tun (denn Windows 10 ist selbstverständlich ebenfalls 64 Bit), sondern mit der offensichtlich installierten 64Bit-Excel-Version.

Gruß Ralf

[volti]

Hallo Strammer Max,

zum Umsetzen von API-Funktonen ist oft ein ein API-Viewer nützlich.
Da kannst Du auch einen passenden Viewer hier im Forum im Bereich Komplettlösungen finden, wie auch umfangreiche andere Beispiele die API-Funktionen benutzen.

https://www.clever-excel-forum.de/Thread-API-Viewer

Falls nicht wider Erwarten noch (ur)alte-Rechner mit Excel-32-Bit (VBA6) bedient werden müssen, kannst Du Dir auch das Separieren mittels der Compilerschalter sparen.
Die PtrSafe-Funktionen funktionieren sowohl bei 64-Bit wie auch bei 32-Bit (VBA7).

Lediglich ein paar Funktionen, wie z.B. Get/SetWindowlong müssen bzgl. 64-Bit anders berücksichtigt werden. Aber die hast Du ja nicht in Deinem Code.

viele Grüße
Karl-Heinz

---

Hallo,

ein ungetesteter Ansatz ohne Gewähr......

Code:

'*******************************
' // This code Sets the BackColor of
' // Pages on a Multipage Control
'*******************************
Option Explicit

'=============================
' // Private Declarations.
'=============================

Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type


' A BITMAPINFO structure for bitmaps with no color palette.
Private Type BITMAPINFO_NoColors
    bmiHeader As BITMAPINFOHEADER
End Type

Private Type BITMAPFILEHEADER
    bfType As Integer
    bfSize As Long
    bfReserved1 As Integer
    bfReserved2 As Integer
    bfOffBits As Long
End Type

Private Type MemoryBitmap
    hdc As LongPtr
    hbm As LongPtr
    oldhDC As LongPtr
    wid As Long
    hgt As Long
    bitmap_info As BITMAPINFO_NoColors
End Type

Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As LongPtr) As LongPtr
Private Declare PtrSafe Function SelectObject Lib "gdi32" ( _
        ByVal hdc As LongPtr, _
        ByVal hObject As LongPtr) As LongPtr
Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hwnd As LongPtr, ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hdc As LongPtr) As Long
Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long
Private Declare PtrSafe Function CreateDIBSection Lib "gdi32" ( _
        ByVal hdc As LongPtr, _
        pBitmapInfo As BITMAPINFO, _
        ByVal un As Long, _
        ByVal lplpVoid As LongPtr, _
        ByVal handle As LongPtr, _
        ByVal dw As Long) As LongPtr
Private Declare PtrSafe Function GetDIBits Lib "gdi32" ( _
        ByVal aHDC As LongPtr, _
        ByVal hBitmap As LongPtr, _
        ByVal nStartScan As Long, _
        ByVal nNumScans As Long, _
        lpBits As Any, _
        lpBI As BITMAPINFO, _
        ByVal wUsage As Long) As Long
Private Declare PtrSafe Function SetRect Lib "user32" ( _
        lpRect As RECT, _
        ByVal X1 As Long, _
        ByVal Y1 As Long, _
        ByVal X2 As Long, _
        ByVal Y2 As Long) As Long
Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hdc As LongPtr, ByVal nBkMode As Long) As Long
Private Declare PtrSafe Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As LongPtr
Private Declare PtrSafe Function FillRect Lib "user32" ( _
        ByVal hdc As LongPtr, _
        lpRect As RECT, _
        ByVal hBrush As LongPtr) As Long
Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" ( _
        ByVal hdc As LongPtr, _
        ByVal nIndex As Long) As Long

Private Type RGBQUAD
    rgbBlue     As Byte
    rgbGreen    As Byte
    rgbRed      As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFOHEADER
    biSize          As Long
    biWidth         As Long
    biHeight        As Long
    biPlanes        As Integer
    biBitCount      As Integer
    biCompression   As Long
    biSizeImage     As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed       As Long
    biClrImportant  As Long
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD
End Type

Private Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

Private Type LOGBRUSH
    lbStyle As Long
    lbColor As Long
    lbHatch As LongPtr
End Type

Private Const DIB_RGB_COLORS = 0&
Private Const BI_RGB = 0&
Private Const LOGPIXELSX As Long = 88
Private Const LOGPIXELSY As Long = 90
Private Const POINTSPERINCH As Long = 72

'=============================
' // Public Routines.
'=============================
Public Sub SetBackColor(Page As MSForms.Page, Color As Long)

    Dim sBMPFile As String
    sBMPFile = Environ("UserProfile") & "\Temp.bmp"
    Dim memory_bitmap As MemoryBitmap

    ' Create the memory bitmap.
    memory_bitmap = MakeMemoryBitmap(Page)

    ' Draw on the bitmap.
    DrawOnMemoryBitmap memory_bitmap, Color

    ' Save the bmp.
    Call SaveMemoryBitmap(memory_bitmap, sBMPFile)

    ' load the bmp onto the page.
    Set Page.Picture = LoadPicture(sBMPFile)

    ' Delete the memory bitmap.
    DeleteMemoryBitmap memory_bitmap

    ' Delete BMP file.
    Kill sBMPFile

End Sub



'=============================
' // Private Routines.
'=============================

' Make a memory bitmap according to the MultiPage size.
Private Function MakeMemoryBitmap(Page As MSForms.Page) As MemoryBitmap

    Dim result As MemoryBitmap
    Dim bytes_per_scanLine As Long
    Dim pad_per_scanLine As Long
    Dim new_font As Long

    ' Create the device context.
    result.hdc = CreateCompatibleDC(0)


    ' Define the bitmap.
    With result.bitmap_info.bmiHeader
        .biBitCount = 32
        .biCompression = BI_RGB
        .biPlanes = 1
        .biSize = LenB(result.bitmap_info.bmiHeader)
        .biWidth = PTtoPX(Page.Parent.Parent.InsideWidth, 0)
        .biHeight = PTtoPX(Page.Parent.Parent.InsideHeight, 1)
        bytes_per_scanLine = ((((.biWidth * .biBitCount) + _
        31) \ 32) * 4)
        pad_per_scanLine = bytes_per_scanLine - (((.biWidth _
        * .biBitCount) + 7) \ 8)
        .biSizeImage = bytes_per_scanLine * Abs(.biHeight)
    End With

    ' Create the bitmap.
    result.hbm = CreateDIBSection( _
    result.hdc, result.bitmap_info, _
    DIB_RGB_COLORS, ByVal 0&, _
    ByVal 0&, ByVal 0&)

    ' Make the device context use the bitmap.
    result.oldhDC = SelectObject(result.hdc, result.hbm)

    ' Return the MemoryBitmap structure.
    result.wid = PTtoPX(Page.Parent.Parent.InsideWidth, 0)
    result.hgt = PTtoPX(Page.Parent.Parent.InsideHeight, 1)

    MakeMemoryBitmap = result

End Function

Private Sub DrawOnMemoryBitmap(memory_bitmap As MemoryBitmap, Color As Long)

   Dim LB As LOGBRUSH, tRect As RECT
   Dim hBrush As LongPtr

   LB.lbColor = Color

   'Create a new brush
    hBrush = CreateBrushIndirect(LB)
    With memory_bitmap
       SetRect tRect, 0, 0, .wid, .hgt
    End With

    SetBkMode memory_bitmap.hdc, 2 'Opaque

    'Paint the mem dc.
    FillRect memory_bitmap.hdc, tRect, hBrush

End Sub

' Save the memory bitmap into a bitmap file.
Private Sub SaveMemoryBitmap(memory_bitmap As MemoryBitmap, ByVal file_name As String)

    Dim bitmap_file_header As BITMAPFILEHEADER
    Dim fnum As Integer
    Dim pixels() As Byte

    ' Fill in the BITMAPFILEHEADER.
    With bitmap_file_header
        .bfType = &H4D42   ' "BM"
        .bfOffBits = Len(bitmap_file_header) + _
        Len(memory_bitmap.bitmap_info.bmiHeader)
        .bfSize = .bfOffBits + _
        memory_bitmap.bitmap_info.bmiHeader.biSizeImage
    End With

    ' Open the output bitmap file.
    fnum = FreeFile
    Open file_name For Binary As fnum
    ' Write the BITMAPFILEHEADER.
    Put #fnum, , bitmap_file_header
    ' Write the BITMAPINFOHEADER.
    ' (Note that memory_bitmap.bitmap_info.bmiHeader.biHeight
    ' must be positive for this.)
    Put #fnum, , memory_bitmap.bitmap_info
    ' Get the DIB bits.
    ReDim pixels(1 To 4, _
    1 To memory_bitmap.wid, _
    1 To memory_bitmap.hgt)
    GetDIBits memory_bitmap.hdc, memory_bitmap.hbm, _
    0, memory_bitmap.hgt, pixels(1, 1, 1), _
    memory_bitmap.bitmap_info, DIB_RGB_COLORS
    ' Write the DIB bits.
    Put #fnum, , pixels
    ' Close the file.
    Close fnum

End Sub

' Delete the bitmap and free its resources.
Private Sub DeleteMemoryBitmap(memory_bitmap As MemoryBitmap)

    SelectObject memory_bitmap.hdc, memory_bitmap.oldhDC
    DeleteObject memory_bitmap.hbm
    DeleteDC memory_bitmap.hdc

End Sub

Private Function ScreenDPI(bVert As Boolean) As Long

    Static lDPI(1) As Long, lDC As LongPtr

    If lDPI(0) = 0 Then
        lDC = GetDC(0)
        lDPI(0) = GetDeviceCaps(lDC, LOGPIXELSX)
        lDPI(1) = GetDeviceCaps(lDC, LOGPIXELSY)
        lDC = ReleaseDC(0, lDC)
    End If

    ScreenDPI = lDPI(Abs(bVert))

End Function

Private Function PTtoPX(Points As Single, bVert As Boolean) As Long

    PTtoPX = Points * ScreenDPI(bVert) / POINTSPERINCH

End Function

_________
viele Grüße
Karl-Heinz

[StrammerMax]

Vielen Dank an euch alle und v.a. an volti für die Vorlage.

Ich werde das zeitnah prüfen.

[volti]

Danke für die Rückmeldung.
Da ist noch ein Type doppelt drin, aber das hast Du ja sicher im Griff.

Wofür ist das Teil eigentlich, irgendwelche Bilder manipulieren o.ä.?

Gruß Karl-Heinz

[volti]

An dieser Stelle noch für alle Interessierte ein Nachtrag zum Umsetzen von 32 auf 64 Bit.

Bei Verwendung meines hier im Forum angebotenen API-Viewers kann man einfach seinen code kopieren und dort über die Zwischenablage einfügen.

Es wird alles in einem Rutsch umgesetzt (mit und/oder ohne VBA6/VBA7-Trennung). Da braucht man dann das nicht einzeln machen.

Lediglich beim Code selbst ist natürlich noch eigens Hand anzulegen.


Gruß KH

[StrammerMax]

Hallo @volti entschuldige bitte die späte Rückmeldung. 

Der Code dient dazu die Hintergrundfarbe eines Fensters in einer Userform zu ändern und highlighted Messageboxen wenn man mit der Maus darüber fährt.

[volti]

Hallo StrammerMax,

vielen Dank für die Aufklärung.

Hatte das dann doch selbst nachvollziehen können.

Ein Teil des Themas (Hintergrundfarbe Multipage) wird auch hier behandelt...

https://www.clever-excel-forum.de/Thread...e-versehen

Gruß KH