Hintergrund der Auflösung anpassen

In manchen Situationen ist es erforderlich den Hintergrund des Desktops der Auflösung anzupassen. Wenn ein Bildschirm oder Anwendung eine bestimmte Auflösung benötigt, oder ein Monitor im Hochformat eingesetzt wird, verzerrt dies das Wallpaper. Um dies zu verhindern führen wir per Gruppenrichtlinie / GPO beim Start ein VB Script aus.

Vorbereitungen

Um das Hintergrund-Bild der passenden Auflösung anpassen zu können, müssen wir folgende Vorbereitungen treffen:

Bilder bereitstellen

Um das zu realisieren, benötigen wir lokal auf dem Computer die Hintergrundbilder in den verschiedenen Auflösungen.
Ihr müsst also die Wallpaper erstellen (lassen) und an einen Ort kopieren, wo die Bilder niemanden stören.
In unserem Fall ist dies “C:\Windows\autobackground\” :-)

(Eventuell auch per Gruppenrichtlinie)

Gruppenrichtlinie erstellen

Mit einer Gruppenrichtlinie auf dem Domain Controller haben wirs sehr einfach, weil es auf alle Computer des Active Directory angewendet werden kann.

Wir erstellen also eine Benutzer / User GPO, die beim Start ein Script ausführt:

Hintergrund der Auflösung anpassen

Nun zum eigentlichen Script. Ist zwar nicht schön geschrieben (Azubi - Zeit), aber es funktioniert ;-)

In Zeile 20-81 werden eure Auflösungen definiert, die abgefragt werden sollen
In den Zeilen 92-102 werden die Pfade der Bilder hinterlegt
Ab Zeile 108 müsst ihr die Bilder den Auflösungen zuordnen

Code

' SYNOPSIS:     Wallpaper der Aufloesung anpassen
' DESCRIPTION:  Aufloesung wird ausgelesen und anhand dessen das korrekte Wallpaper gesetzt
' VERSION:      1.0
' AUTHOR:       www.ITnator.net | Christian Gebhardt
' CREATED:      10.04.2018

Set objFSO = CreateObject("Scripting.FileSystemObject") 
Set objWMIService = GetObject("Winmgmts:\\.\root\cimv2") 
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor where DeviceID = 'DesktopMonitor1'",,0) 
strFileType = "JPG"

 
For Each objItem in colItems 
 intX = objItem.ScreenWidth 
 intY = objItem.ScreenHeight 
Next 

Select Case intX 
 Case "768" 
  Select Case intY 
   Case "1024" 
    strRes = intX & "x" & intY 
   Case "1280" 
    strRes = intX & "x" & intY 
  End Select 
 Case "900" 
  Select Case intY 
   Case "1600" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1024" 
  Select Case intY 
   Case "768" 
    strRes = intX & "x" & intY 
   Case "1280" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1050" 
  Select Case intY 
   Case "1680" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1080" 
  Select Case intY 
   Case "1920" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1152" 
  Select Case intY 
   Case "864" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1280" 
  Select Case intY 
   Case "768" 
    strRes = intX & "x" & intY 
   Case "920" 
    strRes = intX & "x" & intY 
   Case "1024" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1600" 
  Select Case intY 
   Case "900" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1680" 
  Select Case intY 
   Case "1050" 
    strRes = intX & "x" & intY 
  End Select 
 Case "1920" 
  Select Case intY 
   Case "1080" 
    strRes = intX & "x" & intY 
   Case "1200" 
    strRes = intX & "x" & intY 
  End Select 
End Select 

dim shell
dim user
Set shell = WScript.CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
user = shell.ExpandEnvironmentStrings("%USERNAME%")
windowsDir = fso.GetSpecialFolder(0)
wallpaper1 = "C:\Windows\autobackground\4-3_1024x768.jpg"
wallpaper2 = "C:\Windows\autobackground\4-3_1280x1024.jpg"
wallpaper3 = "C:\Windows\autobackground\4-3_1600x1200.jpg"
wallpaper4 = "C:\Windows\autobackground\16-9_1024x600.jpg"
wallpaper5 = "C:\Windows\autobackground\16-9_1080x1920.jpg"
wallpaper6 = "C:\Windows\autobackground\16-9_1600x900.jpg"
wallpaper7 = "C:\Windows\autobackground\16-9_2560x1440.jpg"
wallpaper8 = "C:\Windows\autobackground\16-10_1440x900.jpg"
wallpaper9 = "C:\Windows\autobackground\16-10_1680x1050.jpg"
wallpaper10 = "C:\Windows\autobackground\16-10_1920x1200.jpg"
wallpaper11 = "C:\Windows\autobackground\16-10_1920x1080.jpg"

If intX=1024 And intY=768 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper1
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1280 And intY=1024 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper2
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1600 And intY=1200 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper3
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1024 And intY=600 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper4
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1080 And intY=1920 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper5
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1600 And intY=900 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper6
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=2560 And intY=1440 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper7
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1440 And intY=900 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper8
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1680 And intY=1050 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper9
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1920 And intY=1200 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper10
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

If intX=1920 And intY=1080 Then 
shell.RegWrite "HKCU\Control Panel\Desktop\Wallpaper", wallpaper11
shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
End If

Nach dem Ausführen des VB Scripts, solle euer Desktop - Hintergrund direkt geändert werden :-)

10 Kommentare

Jemand Anders4. Februar 2020

dim vid for each vid in getobject("winmgmts:").instancesof("Win32_VideoController") intX = vid.CurrentHorizontalResolution intY = vid.currentVerticalResolution next dim shell dim user Set shell = WScript.CreateObject("WScript.Shell") Set fso = CreateObject("Scripting.FileSystemObject") user = shell.ExpandEnvironmentStrings("%USERNAME%") windowsDir = fso.GetSpecialFolder(0) wallpaper = windowsDir & "autobackgroundshintergrund-"&intX&"x"&intY&".jpg" shell.RegWrite "HKCUControl PanelDesktopWallpaper", wallpaper shell.Run "C:\Windows\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True etwas kürzere version und funktioniert auf win10 ;)

Johannes Huber4. Februar 2020

Danke dir - ist definitiv einfacher und kürzer :-)

Holger4. Februar 2021

mehr muss da nicht drin stehen? Sorry für die Frage, aber ich bin blutiger Anfänger :-/ LG Holger

Vorbereitungen

Bilder bereitstellen

Gruppenrichtlinie erstellen

Hintergrund der Auflösung anpassen

Johannes Huber

Passend dazu

10 Kommentare

Kommentar schreiben

Neue Anleitungen per E-Mail