Hier habe ich dir mal eine Simulation ...
13.10.2012 23:52:21
Luc:-?
…der in LO üblichen Vorgehensweise als Change-Event-Reaktion von xlVBA angefertigt, Boris;
allerdings geht das natürl nicht ganz so wie in LO (per Pinsel wird da gleich der Standard gewählt → alle Inhalte bleiben erhalten – das Menü erscheint nur bei Symbol-Klick), da Formatieren bekanntl kein Ereignis verursacht, zumindest nicht normales Formatieren, einschl des üblichen Erstellens von VZellen, Formatübertragung per Pinsel aber schon, denn das ist eine Paste-Operation, die Change auslöst. Aber sieh und probier' selbst:
Option Explicit
Dim isJustMerged As Boolean, txMerge As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mx As VbMsgBoxResult, xt As Variant
On Error Resume Next
If Target.MergeCells Then
With WorksheetFunction
xt = .Transpose(Target.Value2)
If IsError(LBound(xt, 2)) Then
Else: xt = .Transpose(xt)
If IsError(LBound(xt, 2)) Then Else Exit Sub
End If
End With
If Join(xt, "") Target.Cells(1) Then
mx = MsgBox("Sollen alle Inhalte der Verbundzelle kombiniert werden?", _
vbQuestion + vbYesNoCancel + vbDefaultButton2, "Verbundzelle")
If mx vbNo Then
With Target
.UnMerge
If mx = vbYes Then
txMerge = Join(xt): isJustMerged = True
Call Worksheet_SelectionChange(Target)
End If
End With
Else: isJustMerged = True
End If
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If isJustMerged And txMerge "" Then
.ClearContents: .Cells(1) = txMerge: .Merge: txMerge = ""
ElseIf .MergeCells And Not IsEmpty(.Cells(1)) And Not isJustMerged Then
If MsgBox("Soll die Verbundzelle aufgehoben werden?", vbQuestion + _
vbYesNo + vbDefaultButton2, "Verbundzelle") = vbYes Then .UnMerge
End If
End With
isJustMerged = False
End Sub
Hier noch als Zugabe eine VBA-Methode zur Erzeugung von VZellen mit allen Inhalten, die eine zuvor angelegte (2zellige) VZelle voraussetzt, hier ab P13 (Konstante nach Wunsch ändern):
Rem Proz erzeugt VbZellen üb Zln/Spn gleich Inhalts 1er Bereichs-
' vektor-Auswahl; vorformatierte 2zell Muster-VbZelle erforderl
' ->Konstante MustAdr entsprd anpassen! Es wird nur die 1.Zelle
' d.Muster-VbZelle verwendet; dadurch wdn idR irreguläre VbZel-
' len erzeugt, die spätestens bei Neustart d.Mappe als reguläre
' erscheinen; Inhalte d.Vb-EinzelZellen bleiben stets erhalten.
' Konst boErg: 0=ohne 1
4=link/recht/ober/unterer ZRahmen(LRTB)
' Vs1.1 -LSr -cd:20120922 -1pub:herber 20121013 -lupd:20120923t
Sub VZSetzen()
Const MustAdr$ = "P13", boErg As Integer = 4
Dim i As Long, j As Long, n As Long, xw As Variant, _
mvz As Range, prs As Range, vz As Range, xz As Range
On Error GoTo fx
Set prs = ActiveWindow.RangeSelection: Set mvz = Range(MustAdr)
For Each xz In prs
i = i + 1
If n > 1 And xz xw Then
Set vz = Range(prs.Cells(i - n), prs.Cells(i - 1))
n = 1: mvz.MergeArea.Cells(1).Copy
vz.PasteSpecial Paste:=xlFormats
If boErg > 1 Then
With vz.Borders(boErg)
.Weight = vz.Borders(boErg - 1).Weight
.LineStyle = vz.Borders(boErg - 1).LineStyle
.ColorIndex = vz.Borders(boErg - 1).ColorIndex
End With
End If
ElseIf Not IsEmpty(xw) And xz = xw Then
n = n + 1
Else: n = 1
End If
xw = xz
Next xz
GoTo ex
fx: MsgBox Err.Description, vbCritical, "VZSetzen: F" & Err.Number
Set xz = Nothing
ex: Set mvz = Nothing: Set prs = Nothing: Set vz = Nothing
End Sub
Viel Spaß u.schöSo, Luc :-?