Mrrrr's Forum (VIEW ONLY)
Un forum care ofera solutii pentru unele probleme legate in general de PC. Pe langa solutii, aici puteti gasi si alte lucruri interesante // A forum that offers solutions to some PC related issues. Besides these, here you can find more interesting stuff.
|
Lista Forumurilor Pe Tematici
|
Mrrrr's Forum (VIEW ONLY) | Reguli | Inregistrare | Login
POZE MRRRR'S FORUM (VIEW ONLY)
Nu sunteti logat.
|
Nou pe simpatie:
Scumpa85 la Simpatie.ro
 | Femeie
24 ani
Bucuresti
cauta Barbat
27 - 45 ani |
|
|
TRaP
Moderator
Inregistrat: acum 8 ani
Postari: 951
|
|
I am in Excel 365 Desktop. I added a border to the bottom of cell A2. The border shows as bottom border for A2, and as top border for A3, as shown in "More Borders". But in reality, it is set only to 1 of the cells, not both cells.
Excel identifies this when dragging formulas or applying formatting - if for cell A2 I would copy the formatting from above (A1), it would erase the border if cell A1 formatting would not include the bottom border, whereas for cell A3, if I would copy the formatting to cell A4, border would not apply to it since it is not actually the top border of cell A3, but a shared border (from A2).
The only way I could make it identify this - with some struggle through simpler and more direct VBA codes - is the VBA code below. It creates a temporary worksheet.
This may seem like a whim, but it is not. When dragging formulas down to a defined range (e.g., totals row), if you add a border to the last row of data before the totals row, the border gets overwritten by above cell formatting, whereas if you add the border as the top border of the totals row, when you update cells above the border doesn't get overwritten since it does not belong to the last cell with data.
' This macro identifies if a cell owns any borders
' Because if you set bottom border to cell A2, the border belongs to A2 and not A3. If you drag A3 down, the border will not apply to next cells.
' In Excel UI this is misleading - in "More Borders" menu it seems that both cells have a border, A2 has bottom and A3 has top.
' The code below identifies if the selected cell - works for 1 cell selections - has any explicit borders it owns.
Sub InspectCellBorderOwnership()
' Ensure exactly one cell is selected
If Selection.count > 1 Then
MsgBox "Please select only 1 cell at a time.", vbExclamation, "Selection Error"
Exit Sub
End If
Dim target As Range
Set target = Selection.Cells(1, 1)
Dim wsTemp As Worksheet
Dim hasTop As Boolean, hasBottom As Boolean
Dim hasLeft As Boolean, hasRight As Boolean
' Prevent screen flicker and dialog alerts during temp sheet creation
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Create an isolated temporary worksheet to eliminate neighbor border leakage
Set wsTemp = Worksheets.Add
' Copy only formatting to A1 on the clean sheet
target.Copy
wsTemp.Range("A1").PasteSpecial xlPasteFormats
Application.CutCopyMode = False
' Inspect isolated cell borders
With wsTemp.Range("A1")
hasTop = (.Borders(xlEdgeTop).LineStyle <> xlNone)
hasBottom = (.Borders(xlEdgeBottom).LineStyle <> xlNone)
hasLeft = (.Borders(xlEdgeLeft).LineStyle <> xlNone)
hasRight = (.Borders(xlEdgeRight).LineStyle <> xlNone)
End With
' Clean up the temporary sheet
wsTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
' Build output string according to border ownership
Dim countBorders As Integer
countBorders = 0
If hasTop Then countBorders = countBorders + 1
If hasBottom Then countBorders = countBorders + 1
If hasLeft Then countBorders = countBorders + 1
If hasRight Then countBorders = countBorders + 1
Dim ownedList As String
ownedList = ""
Select Case countBorders
Case 0
MsgBox "No explicit borders owned", vbInformation, "Border Ownership"
Case 4
MsgBox "All borders are explicit for selected cell.", vbInformation, "Border Ownership"
Case Else
' Assemble comma-separated list of owned sides
If hasTop Then ownedList = ownedList & "TOP, "
If hasBottom Then ownedList = ownedList & "BOTTOM, "
If hasLeft Then ownedList = ownedList & "LEFT, "
If hasRight Then ownedList = ownedList & "RIGHT, "
' Trim trailing comma and space
If Len(ownedList) > 2 Then
ownedList = Left(ownedList, Len(ownedList) - 2)
End If
' Format as: "Cell owns TOP, RIGHT and LEFT explicit borders"
' Replace final comma with "and" if multiple items exist in list
Dim lastCommaPos As Long
lastCommaPos = InStrRev(ownedList, ",")
If lastCommaPos > 0 Then
ownedList = Left(ownedList, lastCommaPos - 1) & " and" & Mid(ownedList, lastCommaPos + 1)
End If
MsgBox "Cell owns " & ownedList & " explicit borders", vbInformation, "Border Ownership"
End Select
End Sub
|
|
|
| pus acum 2 saptamani |
|