Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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, 2431 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 ..
Neuester Wissensbeitrag
Windows 10

Powershell 5 BSOD

(2)

Tipp von agowa338 zum Thema Windows 10 ...

Ähnliche Inhalte
Exchange Server
Exchange 2013 Addressrichtlinie automatisch ausführen (4)

Frage von Bodabirra zum Thema Exchange Server ...

VB for Applications
gelöst VBA-Makro verschwindet nach Speichern (5)

Frage von lupi1989 zum Thema VB for Applications ...

VB for Applications
Powershell Script aus VBA heraus ausführen (2)

Frage von mcnico1978 zum Thema VB for Applications ...

Heiß diskutierte Inhalte
LAN, WAN, Wireless
gelöst Server erkennt Client nicht wenn er ausserhalb des DHCP Pools liegt (28)

Frage von Mar-west zum Thema LAN, WAN, Wireless ...

Windows Server
Server 2008R2 startet nicht mehr (Bad Patch 0xa) (18)

Frage von Haures zum Thema Windows Server ...

Outlook & Mail
Outlook 2010 findet ost datei nicht (18)

Frage von Floh21 zum Thema Outlook & Mail ...