Hintergrund der Auflösung anpassen

Written By Johannes Huber | Coding | 10 Comments

Inhaltsverzeichnis

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 😉

Johannes Huber says:

February 4, 2020 at 12:19 pm

Danke dir – ist definitiv einfacher und kürzer 🙂

Reply
- Gerhard Gasser says:
  
  August 9, 2022 at 6:38 am
  
  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
  
  Reply
  - Johannes says:
    
    August 9, 2022 at 7:48 am
    
    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.
    
    Reply
    - Gerhard Gasser says:
      
      August 9, 2022 at 9:53 am
      
      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 🙂
    - Gerhard Gasser says:
      
      August 10, 2022 at 9:45 am
      
      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
    - Gerhard Gasser says:
      
      August 10, 2022 at 9:46 am
      
      Aufpassen Der pfad stimmt so nicht da fehlen Backslash werden anscheinend gelöscht
    - Johannes says:
      
      August 16, 2022 at 11:25 am
      
      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. 🙁
Holger says:

February 4, 2021 at 8:21 am

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

LG Holger

Reply
- Johannes says:
  
  February 4, 2021 at 8:36 am
  
  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
  
  Reply