Lettergrote dropdown menu

[janaukes]

Ik heb in Excel 2010 een dropdown menu gemaakt.

Ik kan de letters in de bron zo groot maken als ik wil maar in het keuze menu blijven ze minuscuul klein verschijnen.
Hoe krijg ik die letters groter?

 

[Cobbe]

Is dit groot genoeg?

 

[janaukes]

Ik zie in je voorbeeld dat de grootte wordt bepaald door de doelcel.

Mijn probleem is dat de doelcel (AB2) niet zo groot is en de keuze die je in beeld ziet komen ook niet.

Ik zou graag de keuze groter willen hebben zodat ik heel duidelijk in beeld krijg waar ik uit kies. Die pas zich toch wel op de doelcel aan.Bekijk bijlage Kopie van dropdown_lettergrootte-2.xlsxBekijk bijlage Kopie van dropdown_lettergrootte-2.xlsxBekijk bijlage Kopie van dropdown_lettergrootte-2.xlsx

 

[HSV]

De lettergrootte is niet aanpasbaar van een validatielijst.
Het enige wat mogelijk is, is het zoomniveau veranderen.

 

[janaukes]

Hoe verander je het zoomniveau?
Of is dit wat ik al in je bestandje heb gezien?

 

[HSV]

Rechts-onderin; 100% naar bv. 150%

 

[gast0660]

Met volgend stukje code onder het juiste blad gebeurt het zoomen automatisch als je in de cel klikt en wordt alles terug normaal als je een andere cel aanklikt

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  If Target.Address = "$AB$2" Then
    ActiveWindow.Zoom = 150
  Else
    ActiveWindow.Zoom = 100
  End If
End Sub

of voor meerdere cellen

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
  If Target.Cells.Count > 1 Then Exit Sub
  If Intersect(Target, Range("A1,B3,D9")) Is Nothing Then 
    ActiveWindow.Zoom = 100 
  Else 
    ActiveWindow.Zoom = 150 
  End If 
End Sub

Of voor iedere cel met gegevensvalidatie

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim lZoom As Long
  Dim lZoomDV As Long
  Dim lDVType As Long
  lZoom = 100
  lZoomDV = 150
  lDVType = 0

  Application.EnableEvents = False
  On Error Resume Next
  lDVType = Target.Validation.Type
  
    On Error GoTo errHandler
    If lDVType <> 3 Then
      With ActiveWindow
        If .Zoom <> lZoom Then
          .Zoom = lZoom
        End If
      End With
    Else
      With ActiveWindow
        If .Zoom <> lZoomDV Then
          .Zoom = lZoomDV
        End If
      End With
    End If

exitHandler:
  Application.EnableEvents = True
  Exit Sub
errHandler:
  GoTo exitHandler
End Sub

 

[snb]

@Dotchie

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveWindow.Zoom = 100 - 50 * (Not Intersect(Target, Cells.SpecialCells(-4174)) Is Nothing)
End Sub

 

[gast0660]

Thanks Snbie:thumb:
Uitgetest en goedgekeurd
Prachtig stukje code

 

[janaukes]

Hoi Dotchie,

Waar plaats ik de code die je 26 juni laat zien. Ik zou baat hebben bij de variant "per cel" omdat ik meer cellen heb met verschillende teksten.

Of boeit dat niet bij de code voor een heel blad.

Groet, Jan

 

[gast0660]

Hoi,
Beste Jan,
Als ik uw vraag goed heb begrepen.
Deze code

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
  If Target.Cells.Count > 1 Then Exit Sub
  If Intersect(Target, Range("[COLOR="#FF0000"]A1,B3,D9[/COLOR]")) Is Nothing Then 
    ActiveWindow.Zoom = 100 
  Else 
    ActiveWindow.Zoom = 150 
  End If 
End Sub

Verander het rode gedeelte naar de cellen die van toepassing zijn in uw echt bestand.
Plak de volledige code onder het betreffende werkblad.
Zie vbtje

 

[janaukes]

Hallo gast0660,

Ik krijg wel een foutmelding waarbij de Foutopsporing als probleemregel aangeeft: ActiveWindow.Zoom = 100
Als ik i.p.v. Foutopsporing "Beeindigen" aanklik dan werkt alles zonder problemen

Ik werk met de Nederlandse versie. Zou het een taalprobleempje kunnen zijn (Ik werk met 2010 NL)

Groet, Jan

 

[gast0660]

Beste Jan,
geen flauw idee waar het fout gaat, ik heb het getest met Excel 2010 (NL) en ik krijg geen foutmeldingen.
Is uw werkblad beveiligd?
Of heb je een representatief vb bestandje met wat jan,piet, joris en corneel gegevens in?

 

[janaukes]

Beste Philiep,

Inderdaad, de beveiliging.

Allen heel erg bedankt.

Hartelijke groet,
Jan

 

[gast0660]

Hoi Jan,
Probeer het eens zo op een beveiligd werkblad.

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
[COLOR="#FF0000"]ActiveSheet.Unprotect "uw paswoord"[/COLOR]
If Target.Cells.Count > 1 Then Exit Sub
  If Intersect(Target, Range("A1,B3,D9")) Is Nothing Then 
    ActiveWindow.Zoom = 100 
  Else 
    ActiveWindow.Zoom = 150 
  End If 
[COLOR="#FF0000"]ActiveSheet.Protect "uw paswoord"[/COLOR]
End Sub

 

[janaukes]

Lang weg geweest van hier maar weer fris en fruitig.

gast0660, wat je in je post van 11-07 aangeeft werkt.

Heel erg bedankt,
Jan