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
' 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 🙂
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 😉
Danke dir – ist definitiv einfacher und kürzer 🙂
Hi da ist gar nix einfacher 🙂
Kannst du zu dem Script noch ne anleitung schrieben 🙂
Bei deinem Scrit ist ein Zahlen Fehler drin bei wallpaper 11
Der Zahlendreher ist geändert, danke hierfür! 🙂
Wo kann ich dich unterstützen? Mir fehlt die Zeit auf die Schnelle das Script zu kommentieren.
Deines Gefällt mir da ich es selber ein bisschen kapiere.
Aber bei dem kurzen kapier ich gar nix 🙂 Was mir aber gefällt da es so kurz ist 🙂
Hi habe noch mal zeit investiert:
Bei dem einen hat der Reg Pfad nicht gestimmt.
anbei das angepasste klappt auch so mit sysvol share:
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)
‘ DESCRIPTION: Dein Pfad und Datei Endung anpassen
wallpaper = “\DEINPFAD.netSYSVOLDEINPFAD.netscriptsWallpaperWallpaper2_”&intX&”x”&intY&”.png”
shell.RegWrite “HKCUControl PanelDesktopWallpaper”, wallpaper
shell.Run “C:WindowsSystem32RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters”, 1, True
Einzige Problem was immer noch besteht wann der User vorher eine Bilder Diashow drin hatte ändert es sich nach 10 Sec zurück auf seine Diashow eine idee wie das verhindert werden kann.
BG Gerhard
Aufpassen Der pfad stimmt so nicht da fehlen Backslash werden anscheinend gelöscht
Danke für das Bereitstellen deiner Anpassungen! 🙂
In der Theorie müsste man zuerst von Diashow auf ein “einfaches” Hintergrundbild umstellen. Dann sollte der Fehler nicht mehr passieren.
Wie und wo man das macht habe ich auf die schnelle leider nicht herausfinden können. 🙁
mehr muss da nicht drin stehen? Sorry für die Frage, aber ich bin blutiger Anfänger :-/
LG Holger
Hallo Holger 🙂
Im Script wird in Zeile 11 wird die Dateiendung (jpg) hinterlegt.
Ab Zeile 20 werden die Auflösungen und die dazugehörigen Bilder angegeben.
Ansonsten muss nichts angepasst werden.
Gruß Johannes