Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Weergeven resultaten 1 tot 20 van 20

Onderwerp: VBA code werkt ineens niet meer

  1. #1
    Senior Member
    Geregistreerd
    30 oktober 2015
    Vraag is opgelost

    VBA code werkt ineens niet meer

    Ik heb onderstaande code in mijn testbestand staan en daar werkt hij prima, als ik hem vervolgens in het uiteindelijke bestand plaats doet de code niets.
    Wat kan er fout gaan?? Het doel is dat de rij automatisch van groote verandert nagelang de hoeveelheid tekst die word ingevoerd


    Code:
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
    Dim uR As Range, vR As Range, fC As Integer, lC As Integer
    
    Application.ScreenUpdating = False
    
        ActiveSheet.Columns(Target.Column).AutoFit
        ActiveWindow.Zoom = 100
    
        With ActiveSheet
            fC = .UsedRange.Columns(1).Column
            lC = (.UsedRange.Columns.Count) + (fC - 1)
            Set uR = .Range(.Columns(fC), .Columns(lC))
            Application.Goto uR, True
            ActiveWindow.Zoom = True
        End With
    
        Set vR = ActiveWindow.VisibleRange
        vR.Cells(1, 1).Select
    
        If ActiveWindow.Zoom > 100 Then ActiveWindow.Zoom = 100
    
    Application.ScreenUpdating = True
    
    End Sub
    Bijgevoegde bestanden Bijgevoegde bestanden
    Laatst aangepast door marcel31281 : 5 november 2019 om 18:15

  2. #2
    Giga Honourable Senior Member
    Geregistreerd
    18 juli 2008
    Die code behoort in Thisworkbook.
    ____________
    Met vriendelijke groet,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  3. #3
    Senior Member
    Geregistreerd
    30 oktober 2015
    Bedankt voor je reactie, maar zelfs dan werkt het niet goed. Daarnaast staat in mijn testbestand de code ook gewoon achter het werkblad.
    Laatst aangepast door marcel31281 : 5 november 2019 om 20:21

  4. #4
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    En Sub die begint met Workbook_ hoort inderdaad in ThisWorkbook thuis.
    De Worksheet_SelectionChange die achter je werkblad staat verwijst naar een niet bestaand werkblad.
    Tevens staan daar allemaal Subs die m.i. in een Userform thuis horen.
    Allemaal niet echt duidelijk dus qua voorbeeld...
    Laatst aangepast door edmoor : 5 november 2019 om 20:50
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

  5. #5
    Senior Member
    Geregistreerd
    30 oktober 2015
    Blijft raar dat testbestand dezelfde "bende" is en het daar wel werkt, daarnaast heb ik geprobeerd om alle andere code te verwijderen en alleen bovenstaande te laten staan en zelfs dan werkt het niet

  6. #6
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Dan is er dus in dat test bestand toch iets dat anders is.
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

  7. #7
    Senior Member
    Geregistreerd
    30 oktober 2015
    Heb de gehele avond al zitten puzzelen maar zie niet waar het verschil zit...

  8. #8
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Zet dan de code uit #1 eens in de ThisWorkbook sectie en haal alle code achter het werkblad weg.
    Als het dan niet doet wat je precies dan laat het hier maar weten en plaats dat document dan hier.
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

  9. #9
    Senior Member
    Geregistreerd
    30 oktober 2015
    Ik heb het getest en als ik hem in ThisWorkbook zet en tekst bij opmerkingen invul dan loopt het hele bestand vast en vervormt alles

    In het bestand 2020.1 werkt de code wel zoals ik het wil
    Bijgevoegde bestanden Bijgevoegde bestanden

  10. #10
    Tera Honourable Senior Member edmoor's avatar
    Geregistreerd
    8 september 2000
    Locatie
    Zuid-Holland
    Maar er zit weer alles in, dus welke van de Subs doet nu volgens jou z'n werk niet zoals verwacht?
    "It's hardware that makes a machine fast. It's software that makes a fast machine slow. "
    Op rechtstreekse vragen via email of privébericht reageer ik niet. Daar is het forum voor.
    Lees ook: http://www.helpmij.nl/forum/announcement.php?f=5

  11. #11
    Senior Member
    Geregistreerd
    30 oktober 2015
    De code die hier in het 1e bericht genoemd staat, deze zou automatisch de hoogte van de rij moeten doen naargelang hoeveel tekst er in staat.
    Zie ook bestand in bijlage waar alle andere codes uit zijn verwijderd zoals gevraagd
    Bijgevoegde bestanden Bijgevoegde bestanden
    Laatst aangepast door marcel31281 : 6 november 2019 om 12:49

  12. #12
    Senior Member
    Verenigingslid

    Geregistreerd
    27 februari 2016
    Als ik zo naar het voorbeeldbestand kijk gaat je vraag alleen maar over de kolom "Bijzonderheden/opmerkingen".
    Dit is volgens mij de enigste kolom waar je de code voor nodig hebt.

    probeer dit eens:
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
     Range("Tabel15[Bijzonderheden / Opmerkingen]").WrapText = True
    End Sub
    foutje dit zo moeten werken.
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
      With Range("Tabel15[Bijzonderheden / Opmerkingen]")
        .WrapText = True
        .Rows.AutoFit
      End With
    End Sub
    Laatst aangepast door AD1957 : 6 november 2019 om 15:30
    Met vriendelijke groet,
    Albert

  13. #13
    Senior Member
    Geregistreerd
    30 oktober 2015
    Super Bedankt!!

    De code werkt verder prima en doet precies wat ik wil, alleen zodra ik hem in het definitieve bestand plaats heb ik nog steeds hetzelfde probleem dat er niets gebeurt. Het is heel vreemd allemaal

    ----------------------------------

    1000x excuses, er was een foutje in geslopen met plakken van de code , nu werkt het wel, klopt het dat ik de hoogte van de cellen niet meer handmatig kan aanpassen dat dan de code vastloopt? Ik zou graag ipv hoogte 14 standaard 18 of 20 hebben, alleen als ik dit aanpas dan werkt de code niet meer. (wellicht ben ik even te dom om dit zelf op te lossen)
    Laatst aangepast door marcel31281 : 6 november 2019 om 17:22

  14. #14
    Senior Member
    Verenigingslid

    Geregistreerd
    27 februari 2016
    Bij mij werkt de code perfect, te perfect!!!!!!!
    Alle lege rijen in de tabel ( van de betreffende kolom) worden nml. teruggezet naar rowheight=15
    Dat is precies wat met de code gevraagd wordt.

    probeer dit eens.
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
      With Range("Tabel15[Bijzonderheden / Opmerkingen]")
        .WrapText = True
        .Rows.AutoFit
        .Rows.RowHeight = 20 'of 18
      End With
    End Sub
    Laatst aangepast door AD1957 : 6 november 2019 om 21:32
    Met vriendelijke groet,
    Albert

  15. #15
    Senior Member
    Verenigingslid

    Geregistreerd
    27 februari 2016
    Code in #14 werkt ook niet. Ik had hem alleen getest met een tekst die niet langer is
    dan 2 x de kolombreedte. De tekst past dan precies bij een rijhoogte van 20.
    Ik zal eens kijken of ik hiervoor een oplossing vind en anders maar wachten op een echte excel specialist.
    Met vriendelijke groet,
    Albert

  16. #16
    Senior Member
    Verenigingslid

    Geregistreerd
    27 februari 2016
    Voor de lege cellen heb ik een oplossing.
    Als de tekstlengte korter is dan de kolombreedte?? , dit moet ik overlaten aan de EXCEL GOEROES
    Ik hoop dat er iemand is die meekijkt.


    Code:
     With Range("Tabel15[Bijzonderheden / Opmerkingen]")
        .WrapText = True
        .Rows.AutoFit
      End With
      
      Dim rng As Range, cell As Range
      Set rng = Range("Tabel15[Bijzonderheden / Opmerkingen]")
      For Each cell In rng
        If cell.Value = "" Then
        cell.RowHeight = 20
        End If
      Next cell
    Met vriendelijke groet,
    Albert

  17. #17
    Senior Member
    Verenigingslid

    Geregistreerd
    27 februari 2016
    Eigenlijk was de oplossing heel simpel
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
    
      With Range("Tabel15[Bijzonderheden / Opmerkingen]")
        .WrapText = True
        .Rows.AutoFit
      End With
      
      Application.ScreenUpdating = False
        Dim rng As Range, cell As Range
        Set rng = Range("Tabel15[Bijzonderheden / Opmerkingen]")
        For Each cell In rng
          If cell.RowHeight <= 20 Then cell.RowHeight = 20 
        Next cell
      Application.ScreenUpdating = True
     
    End Sub
    Als dit jouw vraag oplost, zet deze dan a.u.b.als opgelost.
    Laatst aangepast door AD1957 : 8 november 2019 om 10:53
    Met vriendelijke groet,
    Albert

  18. #18
    Mega Senior Jack Nouws's avatar
    Geregistreerd
    16 april 2008
    Locatie
    Zundert
    Zou dit ook werken? @ Ad1957
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim table As ListObject
    Set table = ListObjects(1)
      
      If Not Intersect(Target, table.ListColumns(9).DataBodyRange) Is Nothing Then
        With table.ListColumns(9).DataBodyRange
          .WrapText = True
          .EntireColumn.AutoFit
        End With
      End If
      
    End Sub
    
    Wees gelukkig met wat je hebt in plaats van ongelukkig door wat je ontbreekt

  19. #19
    Senior Member
    Verenigingslid

    Geregistreerd
    27 februari 2016
    Hallo Jack,

    De hele vraagstelling en code in #1 heeft volgens mij niets te maken met het probleem.
    Achteraf blijkt dat Marcel de rijhoogte/en tekst terugloop heeft bedoeld.

    De code in #1 werkt niet omdat waarschijnlijk achteraf in kolom N t/m U cellen zijn gevuld.
    Met vriendelijke groet,
    Albert

  20. #20
    Senior Member
    Geregistreerd
    30 oktober 2015
    Voor nu lijkt het probleem opgelost met hoe ik het wil hebben, bedankt voor jullie hulp en tips

  21. Dit topic is automatisch gesloten omdat er sinds vier maanden niet meer op gereageerd is.

    Indien gewenst kan de topicstarter een verzoek tot heropening indienen.

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl

Regels
Help

Helpmij.nl en business

Partners
Sponsoren