Pulldown menu

[Jasper]

Goedemiddag Forum,

 

Ik ben druk bezig in excel maar heb het volgende probleem.

 

Ik kan de breedte van en cel niet aanpassen i.v.m. het afdrukbeleid maar daardoor wordt mijn pulldown menu niet volledig weergegeven.

De tekst wordt ingekort bij het laten zien van het pulldown menu. als ik iets aanklik komt er en getal i.p.v.. tekst dus is het in het scherm heen probleem

 

zie bijgevoegde afbeelding.

 

 

Is hier wat aan te doen?????

[Gast]

Hoi,

Zet volgende code in uw invulformulier (Blad1 in het vbtje dat je gisteren heb gepost voor een andere vraag)

Voorzetje

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myShp As Shape, Drp As Single
If Intersect(Target, [I6,I17]) Is Nothing Then Exit Sub
If Target.Validation.Type = xlValidateList Then
    Set myShp = ActiveSheet.Shapes("Drop Down 1")
    Drp = myShp.Width - Target.Width
    myShp.Width = Sheets("Lijsten").[A:A].Width
    myShp.Left = Target.Left - myShp.Width / 2 + Drp * 2
End If
Set myShp = Nothing
End Sub

En klik nu in I6 of I17

[Jasper]

super! zie dat het nog wel fout kan gaan als je op het eerste pijltje klikt wat je te zien krijgt.

daarna krijg je en pijl iets verder naar rechts te zien. Als je die gebruikt kan ik inderdaad alles goed lezen.

 

om dit op de andere cellen toe te passen en op de pagina van de risico inventarisatie wat moet ik dan doen? ben benieuwd hoe ik dit zelf kan maken.

 

is het dan en kwestie van die cellen erbij zetten in de regel 

If Intersect(Target, [I6,I17]) Is Nothing Then Exit Sub

 

en dit stukje ook voor de risico inventarisatie toe te passen en daar de juiste cellen in te zetten?

[Jasper]

17 uren geleden, Jasper zei:

super! zie dat het nog wel fout kan gaan als je op het eerste pijltje klikt wat je te zien krijgt.

daarna krijg je en pijl iets verder naar rechts te zien. Als je die gebruikt kan ik inderdaad alles goed lezen.

 

om dit op de andere cellen toe te passen en op de pagina van de risico inventarisatie wat moet ik dan doen? ben benieuwd hoe ik dit zelf kan maken.

 

is het dan en kwestie van die cellen erbij zetten in de regel 

If Intersect(Target, [I6,I17]) Is Nothing Then Exit Sub

 

en dit stukje ook voor de risico inventarisatie toe te passen en daar de juiste cellen in te zetten?

het is inmiddels gelukt.

 

gekke is wel zodra ik het excel bestand save dan werkt de macro niet goed meer. Dan sluit ik het en open ik het bestand weer dan is alles weer in orde

[Jasper]

ik heb nu :

 

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myShp As Shape, Drp As Single
If Not (Intersect(Target, [I6,I17]) Is Nothing) Then
    If Target.Validation.Type = xlValidateList Then
        Set myShp = ActiveSheet.Shapes("Drop Down 1")
        Drp = myShp.Width - Target.Width
        myShp.Width = Sheets("Lijsten").[A:A].Width
        myShp.Left = Target.Left - myShp.Width / 2 + Drp * 2
    End If
End If
If Not (Intersect(Target, [J6,J17]) Is Nothing) Then
    If Target.Validation.Type = xlValidateList Then
        Set myShp = ActiveSheet.Shapes("Drop Down 1")
        Drp = myShp.Width - Target.Width
        myShp.Width = Sheets("Lijsten").[C:C].Width
        myShp.Left = Target.Left - myShp.Width / 2 + Drp * 2
    End If
End If
If Not (Intersect(Target, [K6,K17]) Is Nothing) Then
    If Target.Validation.Type = xlValidateList Then
        Set myShp = ActiveSheet.Shapes("Drop Down 1")
        Drp = myShp.Width - Target.Width
        myShp.Width = Sheets("Lijsten").[E:E].Width
        myShp.Left = Target.Left - myShp.Width / 2 + Drp * 2
    End If
End If
Set myShp = Nothing
End Sub

 

[Jasper]

1 uur terug, Jasper zei:

ik heb nu :

 

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim myShp As Shape, Drp As Single
If Not (Intersect(Target, [I6,I17]) Is Nothing) Then
    If Target.Validation.Type = xlValidateList Then
        Set myShp = ActiveSheet.Shapes("Drop Down 1")
        Drp = myShp.Width - Target.Width
        myShp.Width = Sheets("Lijsten").[A:A].Width
        myShp.Left = Target.Left - myShp.Width / 2 + Drp * 2
    End If
End If
If Not (Intersect(Target, [J6,J17]) Is Nothing) Then
    If Target.Validation.Type = xlValidateList Then
        Set myShp = ActiveSheet.Shapes("Drop Down 1")
        Drp = myShp.Width - Target.Width
        myShp.Width = Sheets("Lijsten").[C:C].Width
        myShp.Left = Target.Left - myShp.Width / 2 + Drp * 2
    End If
End If
If Not (Intersect(Target, [K6,K17]) Is Nothing) Then
    If Target.Validation.Type = xlValidateList Then
        Set myShp = ActiveSheet.Shapes("Drop Down 1")
        Drp = myShp.Width - Target.Width
        myShp.Width = Sheets("Lijsten").[E:E].Width
        myShp.Left = Target.Left - myShp.Width / 2 + Drp * 2
    End If
End If
Set myShp = Nothing
End Sub

 

het gaat ook fout als het document en tijdje in gebruik is.

ik krijg en foutmelding op

        Set myShp = ActiveSheet.Shapes("Drop Down 1")
       

van het tweede stuk (J6 J17)