Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

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, 2920 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
gelöst VBA-Makro verschwindet nach Speichern (5)

Frage von lupi1989 zum Thema VB for Applications ...

XML
gelöst Kein automatisches Backup über Button VBA (2)

Frage von Knuefi zum Thema XML ...

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

Frage von mcnico1978 zum Thema VB for Applications ...

VB for Applications
gelöst VBA - Automatisches Entpacken von Zipordnern (6)

Frage von it4baer zum Thema VB for Applications ...

Neue Wissensbeiträge
Ubuntu

Ubuntu 17.10 steht zum Download bereit

(1)

Information von Frank zum Thema Ubuntu ...

Datenschutz

Autofahrer-Pranger - Bewertungsportal illegal

(8)

Information von BassFishFox zum Thema Datenschutz ...

Windows 10

Neues Win10 Funktionsupdate verbuggt RemoteApp

(6)

Information von thomasreischer zum Thema Windows 10 ...

Microsoft

Die neuen RSAT-Tools für Win10 1709 sind da

(2)

Information von DerWoWusste zum Thema Microsoft ...

Heiß diskutierte Inhalte
Router & Routing
Allnet - VDSL2 Modem - SFP (mini-GBIC) (20)

Frage von Dobby zum Thema Router & Routing ...

Voice over IP
DeutschlandLAN IP Voice Data M Premium, Erfahrung mit Faxgeräte? (17)

Frage von liquidbase zum Thema Voice over IP ...

Windows 10
Windows 10 Ordnerfreigabe (15)

Frage von Xaero1982 zum Thema Windows 10 ...

Monitoring
Netzwerk-Monitoring Software (15)

Frage von Ghost108 zum Thema Monitoring ...