Schriftgröße von DropDowns ändern

[SteBen]

Hallo zusammen,

ich habe ein Problem mit der Schriftgröße meiner drop down Felder.
Sie beinhalten recht viele Infos & sind deshalb extrem klein geschrieben.

Habe versucht das Problem mit folgendem Makro zu lösen, klappt aber leider nicht...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Resume Next
If Target.Validation.InCellDropdown Then ActiveWindow.Zoom = 100

On Error GoTo errorhandler
If Target.Validation.InCellDropdown Then ActiveWindow.Zoom = 200
Exit Sub
errorhandler:
ActiveWindow.Zoom = 100
End Sub



jemand andere Ideen?

Danke Euch

[Rabe]

Hi,

zuerst:
Was heißt: klappt leider nicht... ?
Das Makro setzt doch den Zoom auf 200, wie programmiert.

Habe versucht das Problem mit folgendem Makro zu lösen, klappt aber leider nicht...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Resume Next
If Target.Validation.InCellDropdown Then ActiveWindow.Zoom = 100

On Error GoTo errorhandler
If Target.Validation.InCellDropdown Then ActiveWindow.Zoom = 200
Exit Sub
errorhandler:
ActiveWindow.Zoom = 100
End Sub

mein Kenntnisstand:

• mit Resume Next wird bei einem Fehler immer die nächste Zeile ausgeführt.
  
• Im ersten If wird der Zoom auf 100 gestellt
  
• im zweiten If wird er dann sofort auf 200 gestellt
  
• in den Errorhandler kommt er nie
  

dann siehst Du es doch nie im Zoom 100 oder?

Was willst Du eigentlich erreichen?

---

hier wird bei Auswahl eines Dropdowns der Zoom auf 200 gesetzt. Bei Änderung einer anderen Zelle wieder Zoom auf 100:

Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'    On Error Resume Next
   On Error GoTo errorhandler
   If Not Target.Validation.InCellDropdown Then ActiveWindow.Zoom = 100
   If Target.Validation.InCellDropdown Then ActiveWindow.Zoom = 200
   Exit Sub
errorhandler:
   ActiveWindow.Zoom = 100
End Sub

mit dem folgenden COde wird bei Selektion einer Zelle der Zoom verändert:

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo errorhandler
    If Not Target.Validation.InCellDropdown Then ActiveWindow.Zoom = 100
    If Target.Validation.InCellDropdown Then ActiveWindow.Zoom = 200
    Exit Sub
errorhandler:
    ActiveWindow.Zoom = 100
End Sub

[snb]

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Application.EnableEvents = False
   ActiveWindow.Zoom = 100
   If Not Intersect(Target, ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then ActiveWindow.Zoom = 200
   Application.EnableEvents = True
End Sub