• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA code werkt ineens niet meer

Status
Niet open voor verdere reacties.
M

marcel31281

Gebruiker
Lid geworden
30 okt 2015
Berichten
391
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
 

Bijlagen

  • Nieuw OH Bestand test 2.xlsm
    148,7 KB · Weergaven: 37
Laatst bewerkt:
Die code behoort in Thisworkbook.
 
Bedankt voor je reactie, maar zelfs dan werkt het niet goed. Daarnaast staat in mijn testbestand de code ook gewoon achter het werkblad.
 
Laatst bewerkt:
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 bewerkt:
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
 
Dan is er dus in dat test bestand toch iets dat anders is.
 
Heb de gehele avond al zitten puzzelen maar zie niet waar het verschil zit...
 
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.
 
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
 

Bijlagen

  • Nieuw OH Bestand test 2.xlsm
    147,2 KB · Weergaven: 25
  • TEST 2020.1.xlsb
    70,4 KB · Weergaven: 27
Maar er zit weer alles in, dus welke van de Subs doet nu volgens jou z'n werk niet zoals verwacht?
 
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
 

Bijlagen

  • Nieuw OH Bestand test 2.xlsm
    144,6 KB · Weergaven: 33
Laatst bewerkt:
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 bewerkt:
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 bewerkt:
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 bewerkt:
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.
 
Voor de lege cellen heb ik een oplossing.
Als de tekstlengte korter is dan de kolombreedte?? , dit moet ik overlaten aan de EXCEL GOEROES:rolleyes:
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
 
Eigenlijk was de oplossing heel simpel:D
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 bewerkt:
Zou dit ook werken? @ Ad1957
Code: 
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]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
[/FONT]
 
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.
 
Voor nu lijkt het probleem opgelost met hoe ik het wil hebben, bedankt voor jullie hulp en tips :thumb:
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan