Das ist andere Kalkulationssoftware, ...
07.06.2017 23:49:54
Luc:-?
…STeve,
sozusagen Xl-Konkurrenz, LO/OOcalc (LibreOffice/OpenOffice).
Der PgmCode für dieses Problem kann so aussehen:
Rem 2 Zellen verbinden u.HGFarben als FarbVerlaufsGradientFarbStops verwenden
' und ggf wieder trennen u.die 1.u.letzte GradientFarbe als HGFarbe setzen.
' Hinweis: Mittlere FarbStopPositionen (colStPos) testen --> dunkel
Sub Verbinden()
Const colStDgr As Integer = 0
Dim csx As Integer, frb(1) As Long, colStPos, vZ As Range
Set vZ = ActiveWindow.RangeSelection
colStPos = Array(0#, 0.4999, 0.5, 1#)
If vZ.Cells.Count = 2 Then
frb(0) = vZ.Cells(1).Interior.Color
frb(1) = vZ.Cells(2).Interior.Color
vZ.Merge
With vZ.Interior
.Pattern = xlPatternLinearGradient: .Gradient.Degree = colStDgr
.Gradient.ColorStops.Clear
For csx = 0 To UBound(colStPos)
With .Gradient.ColorStops.Add(colStPos(csx))
.Color = frb(csx \ 2)
End With
Next csx
End With
End If
End Sub
Sub Trennen()
Const colStDgr As Integer = 0
Dim csx As Integer, frb(1) As Long, vZ As Range, colSt As ColorStops
Set vZ = ActiveWindow.RangeSelection
If vZ.MergeCells And vZ.Cells.Count = 2 Then
With vZ.Interior
If .Pattern = xlPatternLinearGradient And .Gradient.Degree = colStDgr Then
Set colSt = .Gradient.ColorStops
frb(0) = colSt(1).Color: frb(1) = colSt(colSt.Count).Color
.Gradient.ColorStops.Clear: .Pattern = xlSolid: vZ.UnMerge
Else: Exit Sub
End If
End With
vZ.Cells(1).Interior.Color = frb(0)
vZ.Cells(2).Interior.Color = frb(1)
End If
End Sub
Für horizontale FarbTrennung muss die Konstante colStDgr auf 90 gesetzt wdn, schräg dazwischen bzw danach (<180).
Viel Erfolg! Luc :-?