Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Makro automatisch ausführen bei Zellenänderung VBA

Frage Microsoft Microsoft Office

Mitglied: fireless

fireless (Level 1) - Jetzt verbinden

20.10.2014, aktualisiert 17:19 Uhr, 2992 Aufrufe, 4 Kommentare, 1 Danke

Hallo Community,

ich habe ein Makro, dass mir automatisch die Zeilenhöhe mit Zeilenumbruch anpasst, wenn der Text zu lang ist (es wirkt auf das ganze Tabellenblatt aber mir geht es hauptsächlich um die verbundenen Zellen "D31:M31").
Dies passt auch soweit wenn ich das Makro nach Eingabe des geänderten Textes ausführe.

Nun benötige ich noch, dass das Makro automatisch ausgeführt wird, sobald sich der Text in der Zelle ändert. "Nehmen wir an da steht "hallo" und ich schreibe nun "hallo hans" hinein (natürlich viel länger, damit der Umbruch stattfindet).

Leider funktioniert es nicht mittels VBA, wenn ich den Text ändere.. Weiß jemand rat was ich falsch mache?

Danke für jeden Hinweis !!!


VBA in Tabelle1:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$D$31:$M$31")) Is Nothing Then Zellenanpassen
End Sub

Und hier das Makro:

Sub Zellenanpassen()
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub


VG
fireless

P.S.: Meine VBA Kenntnisse sind eher mau.. von daher nicht böse sein
Mitglied: 114757
20.10.2014, aktualisiert um 16:24 Uhr
Zitat von fireless:
If Not Intersect(Target, Range("$D$31:$M$31§)) Is Nothing Then Zellenanpassen
Das Paragraphenzeichen (§) sollte da eigentlich ein Anführungszeichen sein

Gruß
jodel32
Bitte warten ..
Mitglied: fireless
20.10.2014 um 17:19 Uhr
Ja stimmt, sorry. Ich habe mich hier vertippt.. Leider ist der Code auch mit mit den anführungszeichen nicht richtig bzw funktioniert nicht ...

Gruß
fireless
Bitte warten ..
Mitglied: 114757
21.10.2014 um 14:44 Uhr
ungefähr so:
01.
Private Sub Worksheet_Change(ByVal Target As Range) 
02.
    If Not Intersect(Target, Range("$D$31:$M$31")) Is Nothing Then 
03.
        For Each cell In Target 
04.
            If cell.Value <> "" Then 
05.
                Zellenanpassen Target 
06.
            End If 
07.
        Next 
08.
    End If 
09.
End Sub 
10.
 
11.
Sub Zellenanpassen(ByVal rngTarget As Range) 
12.
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single 
13.
    Dim CurrCell As Range 
14.
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single 
15.
    If rngTarget.MergeCells Then 
16.
        With rngTarget.MergeArea 
17.
            If .Rows.Count = 1 And .WrapText = True Then 
18.
                Application.ScreenUpdating = False 
19.
                CurrentRowHeight = .RowHeight 
20.
                ActiveCellWidth = rngTarget.ColumnWidth 
21.
                For Each CurrCell In rngTarget 
22.
                    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth 
23.
                Next 
24.
                .MergeCells = False 
25.
                .Cells(1).ColumnWidth = MergedCellRgWidth 
26.
                .EntireRow.AutoFit 
27.
                PossNewRowHeight = .RowHeight 
28.
                .Cells(1).ColumnWidth = ActiveCellWidth 
29.
                .MergeCells = True 
30.
                .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight) 
31.
                Application.ScreenUpdating = True 
32.
            End If 
33.
        End With 
34.
    End If 
35.
End Sub
Bitte warten ..
Mitglied: fireless
21.10.2014, aktualisiert um 19:57 Uhr
Hi jodel32,

super!!! Vielen Dank für deine Hilfe! Das funktioniert nun soweit super ! )

Nun noch eine kurze Frage, irgendwie werden verdammt viele Absätze mit eingefügt, ist das normal? Wenn ich die Zeilenhöhe auf "1" stelle, und jetzt ganz viele "OOOO"'s eingebe, bis ich in der Dritten (Neu hinzugefügten Zeile) bin, dann werden sehr viele Absätze eingefügt.

Weißt du dazu auch eine Antwort?

Danke und Gruß

fireless

Edit: Mir ist aufgefallen, dass dementsprechend immer ein neuer leerer Absatz eingefügt wird, wenn ein neues Wort z.B. eingegeben wurde.. Ich wollte eigentlich erreichen, dass wenn der eingegebene Text die Zeile M31 erreicht hat und dann ein Umbruch stattfindet, dass dann die Zeilenhöhe automatisch angepasst wird.. Ist das machbar mit Excel?
Bitte warten ..
Ähnliche Inhalte
VB for Applications
EXCEL VBA 2013 bei inaktiven Fenster Makro ausführen
gelöst Frage von Just4fun1990VB for Applications2 Kommentare

Hallo Administrator.de User, dieses mal kein Problem sondern eine Frage :) . Ist es irgendwie möglich, wenn das Excel ...

VB for Applications
VBA-Makro verschwindet nach Speichern
gelöst Frage von lupi1989VB for Applications5 Kommentare

Liebe Leute, bei mir verschwindet der Makro für den Scrollbereich in Excel(abgespeichert in xlsm) immer wieder nach dem Speichern. ...

Outlook & Mail
Makro ausführen: Liste ist leer
gelöst Frage von mupan7Outlook & Mail3 Kommentare

Bin sicher kein VBA-Neuling, aber mit Outlook, seinem riesigen Objektmodell und seinem <gnx$$§%&> Sicherheitssystem habe ich noch kaum Erfahrung. ...

Microsoft Office
Excel Makro VBA Sortierung nach Spaltennamen
gelöst Frage von easy4breezyMicrosoft Office3 Kommentare

Hi Leute, ich habe mich hier schon eingelesen und auch im Internet, aber irgendwie komme ich zu keiner Lösung ...

Neue Wissensbeiträge
Windows 10

Autsch: Microsoft bündelt Windows 10 mit unsicherer Passwort-Manager-App

Tipp von kgborn vor 21 StundenWindows 102 Kommentare

Unter Microsofts Windows 10 haben Endbenutzer keine Kontrolle mehr, was Microsoft an Apps auf dem Betriebssystem installiert (die Windows ...

Sicherheits-Tools

Achtung: Sicherheitslücke im FortiClient VPN-Client

Tipp von kgborn vor 23 StundenSicherheits-Tools

Ich weiß nicht, wie häufig die NextGeneration Endpoint Protection-Lösung von Fortinet in deutschen Unternehmen eingesetzt wird. An dieser Stelle ...

Internet

USA: Die FCC schaff die Netzneutralität ab

Information von Frank vor 1 TagInternet3 Kommentare

Jetzt beschädigt US-Präsident Donald Trump auch noch das Internet. Der neu eingesetzte FCC-Chef Ajit Pai ist bekannter Gegner einer ...

DSL, VDSL

ALL-BM200VDSL2V - Neues VDSL-Modem mit Vectoring von Allnet

Information von Lochkartenstanzer vor 1 TagDSL, VDSL2 Kommentare

Moin, Falls jemand eine Alternative zu dem draytek sucht: Gruß lks

Heiß diskutierte Inhalte
Windows Server
GPO nur für bestimmte Computer
Frage von Leo-leWindows Server13 Kommentare

Hallo Forum, gern würde ich ein Robocopy script per Bat an eine GPO hängen. Wichtig wäre aber dort der ...

Windows Server
KMS Facts for Client configuration
Frage von winlinWindows Server13 Kommentare

Hey Leute, wir haben in unserem Netz nun einen neuen KMS Server. Haben Bestands-VMs die noch nicht aktiviert sind. ...

Windows Tools
Software-Tool zum Entfernen von bösartigem Windows
Frage von emeriksWindows Tools11 Kommentare

Hi, siehe Betreff hat das jemals irgendjemand schonmal sinnvoll eingesetzt? (MRT) E.

Router & Routing
OpenWRT bzw. L.E.D.E auf Buffalo WZR-HP-AG300H - update
gelöst Frage von EpigeneseRouter & Routing11 Kommentare

Guten Tag, ich habe auf einem Buffalo WZR-HP-AG300H die alternative Firmware vom L.E.D.E Projekt geflasht. Ich bin es von ...