Email HtmlTable

D

Dossfm0q

Banned User
Joined
Mar 9, 2009
Messages
570
Office Version
  1. 2019
Platform
  1. Windows
'it work ok ,It may need some thing
Public Function HorAlignment(Rng)
Select Case Rng
Case -4108: HorAlignment = "Center"
Case -4131: HorAlignment = "Left"
Case -4152: HorAlignment = "Right"
End Select
End Function
Public Function VerAlignment(Rng)
Select Case Rng
Case -4108: VerAlignment = "Center"
Case -4107: VerAlignment = "Bottom"
Case -4160: VerAlignment = "Top"
End Select
End Function
Public Function Orient(Rng)
Select Case Rng
Case -4170: Orient = 90
Case -4171: Orient = -90
Case -4128: Orient = 0
End Select
End Function
Sub Email_Plain()
On Error Resume Next
Dim OutApp As Variant
Dim OutMail As Variant
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
'_________________________________________________________________________________________________
On Error Resume Next
Start = Now
With OutMail
.To = ""
.CC = ""
.Subject = "test"
.HTMLBody = HtmlTable(Range("A1:E14"))
.Save
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
On Error Resume Next
MsgBox Format(Now - Start, "hh:mm:ss")
End Sub
Public Function HtmlTable(TableRng As Range)
'By: Fahad Mubark Al Dossary
Dim Rng As Range
TableBorder = " class=MsoNormalTable border=0 cellspacing=0 cellpadding=0 width=" & TableRng.Width & " style='width:" & TableRng.Width & ".0pt;margin-left:-1.15pt;border-collapse:collapse'"
StrHtml = ""
StrHtml = StrHtml & "<table " & TableBorder & ">"
For Each Rng In TableRng
RngHeight = Rng.Height ' IIf(Rng.MergeCells, "height:" & Rng.MergeArea.Height, "height:" & Rng.Height)
RngWidth = Rng.Width 'IIf(Rng.MergeCells, Rng.MergeArea.Width, Rng.Width)
' If Not Intersect(Rng, Range(CellTypeVisible(TableRng))) Is Nothing Then
If Rng.EntireColumn.Hidden = False And Rng.EntireRow.Hidden = False Then
If Rng.Address = HeadRng(Rng) Then CreatCell = "<TD " & CellRowColNo(Rng) & BorderFormat(TableRng, Rng) & TXTFMT(Rng) & "</TD>"

If Rng.Column = FstCol(TableRng) Then
If Rng.Address = HeadRng(Rng) Then
StrHtml = StrHtml & "<TR style='" & RngHeight & "'>" & CreatCell
Else
StrHtml = StrHtml & "<TR style='" & RngHeight & "'>" '
End If
ElseIf Rng.Column = LstCol(TableRng) Then
If Rng.Address = HeadRng(Rng) Then
StrHtml = StrHtml & CreatCell & "</TR>"
Else
StrHtml = StrHtml & "</TR>"
End If
ElseIf Rng.Address = HeadRng(Rng) Then
StrHtml = StrHtml & CreatCell
End If
End If
Next
StrHtml = StrHtml & "</TABLE>"

HtmlTable = StrHtml
End Function
Public Function TXTFMT(Rng As Range)
'By: Fahad Mubark Al Dossary
Dim I As Long
With Range(RootRng(Rng))
Start = ""
Length = ""
MyCharact = ""

S = 1
For I = 1 To Len(Rng.Text)
Set p = Rng.Characters(Start:=I, Length:=1).Font
Set N = Rng.Characters(Start:=I + IIf(I < Len(Rng.Text), 1, 0), Length:=1).Font
' if Cell letters have different color, size …..
If Rng.Text <> "" And ((p.Name <> N.Name) Or (p.FontStyle <> N.FontStyle) Or (p.Size <> N.Size) Or (p.Strikethrough <> N.Strikethrough) Or (p.Superscript <> N.Superscript) Or (p.Subscript <> N.Subscript) Or (p.Underline <> N.Underline) Or (p.Color <> N.Color) Or (I = Len(Rng.Text))) Then

Start = S
Length = I - S + 1 ' Calculate Characters is the same
S = I + 1 ' Reset Start
FontName = "font-family:" & Rng.Characters(Start:=Start, Length:=Length).Font.Name & ";"
FontSize = "font-size:" & Rng.Characters(Start:=Start, Length:=Length).Font.Size & ".0pt" & ";"
FontColor = "color:" & ConvertToHtmlcolor(p.Color) & ";"

With Rng.Characters(Start:=Start, Length:=Length).Font
' format Font
StartFormat = IIf(.Bold = True, "<b>", "") & IIf(.Italic = True, "<i>", "") & IIf(.Underline = 2, "<u>", "") & IIf(.Superscript = True, "<sup>", "") & IIf(.Subscript = True, "<sub>", "") & "<span style='" & FontName & FontSize & FontColor & Spacing & "'>"
'Finsh format Font
EndFormat = "</span>" & IIf(.Subscript = True, "</sub>", "") & IIf(.Superscript = True, "</sup>", "") & IIf(.Underline = 2, "</u>", "") & IIf(.Italic = True, "</i>", "") & IIf(.Bold = True, "</b>", "")
End With

Charact = StartFormat & Mid(Rng.Text, Start, Length) & EndFormat
MyCharact = MyCharact & Charact
Else

End If
Next I
' if Cell Characters have same color, size …..
If Rng.Text <> "" And MyCharact = "" Then
FontName = "font-family:" & Rng.Font.Name & ";"
FontSize = "font-size:" & Rng.Font.Size & ".0pt" & ";"
FontColor = "color:" & ConvertToHtmlcolor(p.Color) & ";"

StartFormat = IIf(.Bold = True, "<b>", "") & IIf(.Italic = True, "<i>", "") & IIf(.Underline = 2, "<u>", "") & IIf(.Superscript = True, "<sup>", "") & IIf(.Subscript = True, "<sub>", "") & "<span style='" & FontName & FontSize & FontColor & Spacing & "'>"
EndFormat = "</span>" & IIf(.Subscript = True, "</sub>", "") & IIf(.Superscript = True, "</sup>", "") & IIf(.Underline = 2, "</u>", "") & IIf(.Italic = True, "</i>", "") & IIf(.Bold = True, "</b>", "")

Charact = StartFormat & Rng.Text & EndFormat
MyCharact = Charact
End If
If .Value <> "" Then
TXTFMT = "<p class=MsoNormal" & HorAlign(Rng) & " style='text-align:" & Mid(HorAlign(Rng), InStr(HorAlign(Rng), "=") + 1, Len(HorAlign(Rng)) - InStr(HorAlign(Rng), "=") + 1) & " '>" & MyCharact & "</p>"
Else
TXTFMT = ""
End If
End With
End Function
Public Function BorderFormat(TableRng As Range, Rng As Range) As String
'By: Fahad Mubark Al Dossary
Dim I As Long
Dim Region As Range
Dim R As Range
Dim X As Range
Dim EdgeTop, EdgeBottom, EdgeRight, Edgeleft, CellHeight, CellWidth, WrapText, Padding As String
With Rng
For I = 7 To 10
If Rng.MergeCells = True And Rng.Address = HeadRng(Rng) Then
If CellRowColNo(Rng) <> "" Then
Set Region = Range(Rng.MergeArea.Address)
'Lift Side Range to find if have same color or different color, if they have different color this Edge side will have no color unless this edge is edge of Table
Lft = Cells(FstRw(Region), FstCol(Region)).Address & ":" & Cells(LstRw(Region), FstCol(Region)).Address
'Top Side range .......
tp = Cells(FstRw(Region), FstCol(Region)).Address & ":" & Cells(FstRw(Region), LstCol(Region)).Address
'Bottom Side range........
BTM = Cells(LstRw(Region), FstCol(Region)).Address & ":" & Cells(LstRw(Region), LstCol(Region)).Address
'Right Side range.......
Rght = Cells(FstRw(Region), LstCol(Region)).Address & ":" & Cells(LstRw(Region), LstCol(Region)).Address
Select Case I
Case 7: EdgeRng = Lft ' xlEdgeLeft 7 Enumeration ( Border at the left-hand edge of the range.)
Case 8: EdgeRng = tp 'xlEdgeTop 8 Enumeration ( Border at the top of the range.)
Case 9: EdgeRng = BTM 'xlEdgeBottom 9 Enumeration (Border at the bottom of the range.)
Case 10: EdgeRng = Rght 'xlEdgeRight 10 Enumeration (Border at the right-hand edge of the range.)
End Select
Set R = Range(FstCell(Range(EdgeRng)))
End If
On Error Resume Next
' MsgBox I & " " & R.Address & " " & Rng.Address & CellRowColNo(R) & " " & R.Column & " " & FstCol(TableRng) & " " & I & " " & 7 & (CellRowColNo(R) <> "" And R.Column <> FstCol(TableRng) And I = 7) & (CellRowColNo(R) <> "" And R.Column <> LstCol(TableRng) And I = 10) & (CellRowColNo(R) <> "" And R.Row <> FstRw(TableRng) And I = 8) & (CellRowColNo(R) <> "" And R.Row <> LstRw(TableRng) And I = 9)
If (CellRowColNo(R) <> "" And R.Column <> FstCol(TableRng) And I = 7) Or (CellRowColNo(R) <> "" And R.Column <> LstCol(TableRng) And I = 10) Or (CellRowColNo(R) <> "" And R.Row <> FstRw(TableRng) And I = 8) Or (CellRowColNo(R) <> "" And R.Row <> LstRw(TableRng) And I = 9) Then 'if Merge Cells Side Edge is not side edge of Table.
' (CellRowColNo(R) <> "" And R.Column <> FstCol(TableRng) And I = 7) Or (CellRowColNo(R) <> "" And R.Column <> LstCol(TableRng) And I = 10) Or (CellRowColNo(R) <> "" And R.Row <> FstRw(TableRng) And I = 8) Or (CellRowColNo(R) <> "" And R.Row <> LstRw(TableRng) And I = 9)
For Each X In Range(EdgeRng)
If X.Borders(I).Color <> R.Borders(I).Color Then 'If Merge Cells Edge have different color ( bisde Cells color ) unless this edge is edge of Table
edge = "none "
Exit For
'Else 'If Merge Cells Edge have one color ( bisde Cells color ) or this edge is edge of Table

End If
Next
Else
With Rng.MergeArea

'xlLineStyle Enumeration None -4142 No line. )
If .Borders(I).LineStyle = -4142 Then ' if no color
edge = "none "
'XlLineStyle Enumeration (xlContinuous 1 Continuous line.)
ElseIf .Borders(I).LineStyle = 1 Then
edge = "Solid " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1.5 & "pt", (.Borders(I).Weight / 2) & "pt")
'XlLineStyle Enumeration (xlDot -4118 Dotted line. )
ElseIf .Borders(I).LineStyle = -4118 Then
edge = "dotted " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1.5 & "pt", (.Borders(I).Weight / 2) & "pt")
'XlLineStyle Enumeration xlDash -4115 Dashed line.)
ElseIf .Borders(I).LineStyle = -4115 Or .Borders(I).LineStyle = 4 Or .Borders(I).LineStyle = 5 Or .Borders(I).LineStyle = 13 Then
edge = "dashed " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1.5 & "pt", (.Borders(I).Weight / 2) & "pt")
End If
End With
End If

ElseIf Rng.MergeCells = False And Rng.Address = HeadRng(Rng) Then 'color unmerge cells side edge
'xlLineStyleNone -4142 No line. )
If .Borders(I).LineStyle = -4142 Then ' if no color
edge = "none "
'XlLineStyle Enumeration (xlContinuous 1 Continuous line.)
ElseIf .Borders(I).LineStyle = 1 Then
edge = "Solid " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1.5 & "pt", (.Borders(I).Weight / 2) & "pt")
'XlLineStyle Enumeration (xlDot -4118 Dotted line. )
ElseIf .Borders(I).LineStyle = -4118 Then
edge = "dotted " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1.5 & "pt", (.Borders(I).Weight / 2) & "pt")
'XlLineStyle Enumeration xlDash -4115 Dashed line.)
ElseIf .Borders(I).LineStyle = -4115 Or .Borders(I).LineStyle = 4 Or .Borders(I).LineStyle = 5 Or .Borders(I).LineStyle = 13 Then
edge = "dashed " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1.5 & "pt", (.Borders(I).Weight / 2) & "pt")
End If
End If

If I = 7 Then Edgeleft = "border-Left:" & edge
If I = 8 Then EdgeTop = "border-Top:" & edge

If I = 9 Then EdgeBottom = "border-Bottom:" & edge

If I = 10 Then EdgeRight = "border-Right:" & edge

Next I
'^
If Orient(Rng.Orientation) = 90 Then '|
FontRotate = "mso-rotate:" & 90 ' -|--->
ElseIf Orient(Rng.Orientation) = -90 Then
FontRotate = "mso-rotate:" & -90
ElseIf Orient(Rng.Orientation) = 0 Then
FontRotate = "mso-rotate:" & 0
Else
FontRotate = "mso-rotate:" & .Orientation
End If

If Rng.MergeCells Then
CellHeight = "height:" & Rng.MergeArea.Height
Else
CellHeight = "height:" & Rng.Height
End If
CellWidth = "Width:" & Rng.Width
If .WrapText = False Then
WrapText = " nowrap "
Else
WrapText = ""
End If

Background = "background:" & ConvertToHtmlcolor(Rng.Interior.Color)
Padding = "padding:0in 5.4pt 0in 5.4pt"


End With
'style='width:113.0pt;border:solid red 1.5pt;background:yellow;padding:0in 5.4pt 0in 5.4pt;mso-rotate:90;height:66.0pt'

BorderFormat = WrapText & VertAlig(Rng) & " cellspacing = 0 style='"

Dim TXT As Variant
Dim Mytext(1 To 9) As String
Mytext(1) = CellWidth: Mytext(2) = EdgeTop: Mytext(3) = EdgeBottom: Mytext(4) = EdgeRight: Mytext(5) = Edgeleft: Mytext(6) = Background: Mytext(7) = Padding: Mytext(8) = FontRotate: Mytext(9) = CellHeight
For Each Sentences In Mytext
If Sentences <> "" Then
If TXT <> "" Then
TXT = TXT & ";" & Sentences
Else
TXT = Sentences
End If
End If
Next
BorderFormat = BorderFormat & TXT & " ' >"
End Function
Public Function CellRowColNo(Rng As Range) As String
'By: Fahad Mubark Al Dossary
Dim RwPan As Long
Dim ClPan As Long
Dim RwN, ColN As String
If Rng.MergeCells Then
If Rng.Address = HeadRng(Rng) Then
RwPan = CountUnhidRowMerRng(Range(Rng.MergeArea.Address))
ClPan = CountUnhidColumnMerRng(Range(Rng.MergeArea.Address))
End If
Else
RwPan = 1
ClPan = 1
End If
If RwPan > 1 Then
RwN = " rowSpan =" & RwPan
Else
RwN = ""
End If

If ClPan > 1 Then
ColN = " colspan =" & ClPan
Else
ColN = ""
End If
CellRowColNo = RwN & ColN
End Function
Public Function RootRng(Rng As Range)
'By: Fahad Mubark Al Dossary
If Rng.MergeCells Then
RootRng = Left(Rng.MergeArea.Address, InStr(Rng.MergeArea.Address, ":") - 1)
Else
RootRng = Rng.Address
End If
End Function
Public Function HeadRng(Rng As Range) As String
'By: Fahad Mubark Al Dossary
Dim Sign As String
If Rng.MergeCells Then
RngArea = ""
RngArea = CellTypeVisible(Rng.MergeArea)
'or
'RngArea = Rng.MergeArea.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = 1 To Len(RngArea)
If Mid(RngArea, I, 1) = ":" Or Mid(RngArea, I, 1) = "," Then
HeadRng = Mid(RngArea, 1, I - 1)
Exit Function
End If
Next I
HeadRng = RngArea
Else
HeadRng = Rng.Address
End If
End Function
Public Function HorAlign(Rng As Range) As String
'By: Fahad Mubark Al Dossary
With Range(RootRng(Rng))
Hor = HorAlignment(.HorizontalAlignment)
Ver = VerAlignment(.VerticalAlignment)
If Orient(Rng.Orientation) = 90 Then
HorAlign = IIf(Ver = "Top", " Align =" & "Right", IIf(Ver = "Bottom", " Align =" & "Left", " Align =" & "Center"))
ElseIf Orient(Rng.Orientation) = -90 Then
HorAlign = IIf(Ver = "Top", " Align =" & "Left", IIf(Ver = "Bottom", " Align =" & "Right", " Align =" & "Center"))

Else

HorAlign = " Align =" & Hor

End If
End With
End Function
Public Function VertAlig(Rng As Range) As Variant
'By: Fahad Mubark Al Dossary
With Range(RootRng(Rng))
Hor = HorAlignment(.HorizontalAlignment)
Ver = VerAlignment(.VerticalAlignment)
If Orient(Rng.Orientation) = 90 Then
VertAlig = IIf(Hor = "Left", " Valign =" & "Top", IIf(Hor = "Right", " Valign =" & "Bottom", " Valign =" & "Center"))
ElseIf Orient(Rng.Orientation) = -90 Then
VertAlig = IIf(Hor = "Left", " Valign =" & "Bottom", IIf(Hor = "Right", " Valign =" & "Top", " Valign =" & "Center"))

Else
VertAlig = " Valign =" & Ver
End If
End With
End Function
Public Function CellTypeVisible(MyRng As Range) As String
' By: Fahad Mubark Al Dossary
' to be used instead of Rng.SpecialCells(xlCellTypeVisible) in case of you want it as formula in cell
Dim Rng As Range
Dim FstRng As Range
Dim LstRng As Range
If InStr(MyRng.Address, ":") > 0 Then
Set FstRng = Range(Left(MyRng.Address, InStr(MyRng.Address, ":") - 1))
Else
Set FstRng = MyRng
End If
If InStr(MyRng.Address, ":") > 0 Then
Set LstRng = Range(Right(MyRng.Address, Len(MyRng.Address) - InStr(MyRng.Address, ":")))
Else
Set LstRng = MyRng
End If
Dim I, Rw, col As Long
Dim STxt, ETxt, TXT, Txt1 As String
On Error Resume Next
For Each Rng In MyRng
If (Rng.EntireColumn.Hidden = False And Rng.EntireRow.Hidden = False) Then
If (Cells(Rng.Row, Rng.Column - IIf(Rng.Column = 1, 0, 1)).EntireColumn.Hidden = True Or Rng.Column = FstRng.Column) And (Cells(Rng.Row - IIf(Rng.Row = 1, 0, 1), Rng.Column).EntireRow.Hidden = True Or Rng.Row = FstRng.Row) Then
STxt = Rng.Address
For I = 1 To MyRng.Rows.Count
If Cells(Rng.Row + 1, Rng.Column).EntireRow.Hidden = True Or Cells(Rng.Row, Rng.Column).Row = LstRng.Row Then
Rw = Cells(Rng.Row, Rng.Column).Row
ElseIf (Cells(Rng.Row + I + 1, Rng.Column).EntireRow.Hidden = True Or Cells(Rng.Row + I, Rng.Column).Row = LstRng.Row) And Cells(Rng.Row + 1, Rng.Column).EntireRow.Hidden <> True Then
Rw = Cells(Rng.Row + I, Rng.Column).Row

Exit For
End If
Next I

For I = 1 To MyRng.Columns.Count
If Cells(Rng.Row, Rng.Column + 1).EntireColumn.Hidden = True Or Cells(Rng.Row, Rng.Column).Column = LstRng.Column Then
col = Cells(Rng.Row, Rng.Column).Column
ElseIf (Cells(Rng.Row, Rng.Column + I + 1).EntireColumn.Hidden = True Or Cells(Rng.Row, Rng.Column + I).Column = LstRng.Column) And Cells(Rng.Row, Rng.Column + 1).EntireColumn.Hidden <> True Then
col = Cells(Rng.Row, Rng.Column + I).Column
Exit For
End If
Next I
ETxt = Cells(Rw, col).Address
If STxt <> ETxt Then
TXT = STxt & ":" & ETxt
Else
TXT = STxt
End If
Txt1 = Txt1 & IIf(Txt1 <> "", ",", "") & TXT
Else
End If
End If


Next
On Error GoTo 0
CellTypeVisible = Txt1
STxt = ""
TXT = ""

End Function
Public Function FstCell(TableRng As Range) As String
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
'VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
If InStr(VisTableRng, ":") > 0 Then
For I = 1 To Len(VisTableRng)
If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
FstCell = Range(Mid(VisTableRng, 1, I - 1)).Address
Exit Function
End If
Next I
Else
FstCell = VisTableRng
End If
End Function
Public Function FstCol(TableRng As Range) As Long
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
' VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = 1 To Len(VisTableRng)
If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
FstCol = Range(Mid(VisTableRng, 1, I - 1)).Column
Exit Function
End If
Next I
End Function
Public Function LstCol(TableRng As Range) As Long
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
'VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = Len(VisTableRng) To 1 Step -1
If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
LstCol = Range(Mid(VisTableRng, I + 1, 99)).Column
Exit Function
End If
Next I
End Function
Public Function FstRw(TableRng As Range) As Long
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
'VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = 1 To Len(VisTableRng)
If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
FstRw = Range(Mid(VisTableRng, 1, I - 1)).Row
Exit Function
End If
Next I
End Function
Public Function LstRw(TableRng As Range) As Long
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
'VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = Len(VisTableRng) To 1 Step -1
If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
LstRw = Range(Mid(VisTableRng, I + 1, 99)).Row
Exit Function
End If
Next I
End Function
Public Function CountUnhidRowMerRng(MyRange As Range)
'By: Fahad Mubark Al Dossary
Dim Rng As Range
Dim UnhCount, Count As Long
UnhCount = 0
For Each Rng In MyRange
If Rng.MergeCells Then
If Rng.EntireRow.Hidden = False And Rng.Column = Range(HeadRng(Rng)).Column Then
Count = 1
Else
Count = 0
End If
UnhCount = UnhCount + Count
End If
Next
CountUnhidRowMerRng = UnhCount
End Function
Public Function CountUnhidColumnMerRng(MyRange As Range)
'By: Fahad Mubark Al Dossary
Dim Rng As Range
Dim UnhCount, Count As Long
UnhCount = 0
'Myrange As Range
For Each Rng In MyRange
If Rng.MergeCells Then
If Rng.EntireColumn.Hidden = False And Rng.Row = Range(HeadRng(Rng)).Row Then
Count = 1
Else
Count = 0
End If
UnhCount = UnhCount + Count
End If
Next
CountUnhidColumnMerRng = UnhCount
End Function
Public Function ConvertToHtmlcolor(XColor As Variant)
'Excel 2010 Developer Reference > Excel Object Model Reference > Enumerations
'XlRgbColor Enumeration
'Specifies the RGB color.
'Version Information
' Version Added: Excel 2007

Dim HTMLcolor, RngColor As String
RngColor = Right("000000" & Hex(XColor), 6)
Select Case XColor
Case 16775408: HTMLcolor = "AliceBlue"
Case 14150650: HTMLcolor = "AntiqueWhite"
Case 16776960: HTMLcolor = "Aqua"
Case 13959039: HTMLcolor = "Aquamarine"
Case 16777200: HTMLcolor = "Azure"
Case 14480885: HTMLcolor = "Beige"
Case 12903679: HTMLcolor = "Bisque"
Case 0: HTMLcolor = "Black"
Case 13495295: HTMLcolor = "BlanchedAlmond"
Case 16711680: HTMLcolor = "Blue"
Case 14822282: HTMLcolor = "BlueViolet"
Case 2763429: HTMLcolor = "Brown"
Case 8894686: HTMLcolor = "BurlyWood"
Case 10526303: HTMLcolor = "CadetBlue"
Case 65407: HTMLcolor = "Chartreuse"
Case 5275647: HTMLcolor = "Coral"
Case 15570276: HTMLcolor = "CornflowerBlue"
Case 14481663: HTMLcolor = "Cornsilk"
Case 3937500: HTMLcolor = "Crimson"
Case 9109504: HTMLcolor = "DarkBlue"
Case 9145088: HTMLcolor = "DarkCyan"
Case 755384: HTMLcolor = "DarkGoldenrod"
Case 11119017: HTMLcolor = "DarkGray"
Case 25600: HTMLcolor = "DarkGreen"
Case 11119017: HTMLcolor = "DarkGrey"
Case 7059389: HTMLcolor = "DarkKhaki"
Case 9109643: HTMLcolor = "DarkMagenta"
Case 3107669: HTMLcolor = "DarkOliveGreen"
Case 36095: HTMLcolor = "DarkOrange"
Case 13382297: HTMLcolor = "DarkOrchid"
Case 139: HTMLcolor = "DarkRed"
Case 8034025: HTMLcolor = "DarkSalmon"
Case 9419919: HTMLcolor = "DarkSeaGreen"
Case 9125192: HTMLcolor = "DarkSlateBlue"
Case 5197615: HTMLcolor = "DarkSlateGray"
Case 5197615: HTMLcolor = "DarkSlateGrey"
Case 13749760: HTMLcolor = "DarkTurquoise"
Case 13828244: HTMLcolor = "DarkViolet"
Case 9639167: HTMLcolor = "DeepPink"
Case 16760576: HTMLcolor = "DeepSkyBlue"
Case 6908265: HTMLcolor = "DimGray"
Case 6908265: HTMLcolor = "DimGrey"
Case 16748574: HTMLcolor = "DodgerBlue"
Case 2237106: HTMLcolor = "FireBrick"
Case 15792895: HTMLcolor = "FloralWhite"
Case 2263842: HTMLcolor = "ForestGreen"
Case 16711935: HTMLcolor = "Fuchsia"
Case 14474460: HTMLcolor = "Gainsboro"
Case 16775416: HTMLcolor = "GhostWhite"
Case 55295: HTMLcolor = "Gold"
Case 2139610: HTMLcolor = "Goldenrod"
Case 8421504: HTMLcolor = "Gray"
Case 32768: HTMLcolor = "Green"
Case 3145645: HTMLcolor = "GreenYellow"
Case 8421504: HTMLcolor = "Grey"
Case 15794160: HTMLcolor = "Honeydew"
Case 11823615: HTMLcolor = "HotPink"
Case 6053069: HTMLcolor = "IndianRed"
Case 8519755: HTMLcolor = "Indigo"
Case 15794175: HTMLcolor = "Ivory"
Case 9234160: HTMLcolor = "Khaki"
Case 16443110: HTMLcolor = "Lavender"
Case 16118015: HTMLcolor = "LavenderBlush"
Case 64636: HTMLcolor = "LawnGreen"
Case 13499135: HTMLcolor = "LemonChiffon"
Case 15128749: HTMLcolor = "LightBlue"
Case 8421616: HTMLcolor = "LightCoral"
Case 9145088: HTMLcolor = "LightCyan"
Case 13826810: HTMLcolor = "LightGoldenrodYellow"
Case 13882323: HTMLcolor = "LightGray"
Case 9498256: HTMLcolor = "LightGreen"
Case 13882323: HTMLcolor = "LightGrey"
Case 12695295: HTMLcolor = "LightPink"
Case 8036607: HTMLcolor = "LightSalmon"
Case 11186720: HTMLcolor = "LightSeaGreen"
Case 16436871: HTMLcolor = "LightSkyBlue"
Case 10061943: HTMLcolor = "LightSlateGray"
Case 14599344: HTMLcolor = "LightSteelBlue"
Case 14745599: HTMLcolor = "LightYellow"
Case 65280: HTMLcolor = "Lime"
Case 3329330: HTMLcolor = "LimeGreen"
Case 15134970: HTMLcolor = "Linen"
Case 128: HTMLcolor = "Maroon"
Case 11206502: HTMLcolor = "MediumAquamarine"
Case 13434880: HTMLcolor = "MediumBlue"
Case 13850042: HTMLcolor = "MediumOrchid"
Case 14381203: HTMLcolor = "MediumPurple"
Case 7451452: HTMLcolor = "MediumSeaGreen"
Case 15624315: HTMLcolor = "MediumSlateBlue"
Case 10156544: HTMLcolor = "MediumSpringGreen"
Case 13422920: HTMLcolor = "MediumTurquoise"
Case 8721863: HTMLcolor = "MediumVioletRed"
Case 7346457: HTMLcolor = "MidnightBlue"
Case 16449525: HTMLcolor = "MintCream"
Case 14804223: HTMLcolor = "MistyRose"
Case 11920639: HTMLcolor = "Moccasin"
Case 11394815: HTMLcolor = "NavajoWhite"
Case 8388608: HTMLcolor = "Navy"
Case 8388608: HTMLcolor = "NavyBlue"
Case 15136253: HTMLcolor = "OldLace"
Case 32896: HTMLcolor = "Olive"
Case 2330219: HTMLcolor = "OliveDrab"
Case 42495: HTMLcolor = "Orange"
Case 17919: HTMLcolor = "OrangeRed"
Case 14053594: HTMLcolor = "Orchid"
Case 7071982: HTMLcolor = "PaleGoldenrod"
Case 10025880: HTMLcolor = "PaleGreen"
Case 15658671: HTMLcolor = "PaleTurquoise"
Case 9662683: HTMLcolor = "PaleVioletRed"
Case 14020607: HTMLcolor = "PapayaWhip"
Case 12180223: HTMLcolor = "PeachPuff"
Case 4163021: HTMLcolor = "Peru"
Case 13353215: HTMLcolor = "Pink"
Case 14524637: HTMLcolor = "Plum"
Case 15130800: HTMLcolor = "PowderBlue"
Case 8388736: HTMLcolor = "Purple"
Case 255: HTMLcolor = "Red"
Case 9408444: HTMLcolor = "RosyBrown"
Case 14772545: HTMLcolor = "RoyalBlue"
Case 7504122: HTMLcolor = "Salmon"
Case 6333684: HTMLcolor = "SandyBrown"
Case 5737262: HTMLcolor = "SeaGreen"
Case 15660543: HTMLcolor = "Seashell"
Case 2970272: HTMLcolor = "Sienna"
Case 12632256: HTMLcolor = "Silver"
Case 15453831: HTMLcolor = "SkyBlue"
Case 13458026: HTMLcolor = "SlateBlue"
Case 9470064: HTMLcolor = "SlateGray"
Case 16448255: HTMLcolor = "Snow"
Case 8388352: HTMLcolor = "SpringGreen"
Case 11829830: HTMLcolor = "SteelBlue"
Case 9221330: HTMLcolor = "Tan"
Case 8421376: HTMLcolor = "Teal"
Case 14204888: HTMLcolor = "Thistle"
Case 4678655: HTMLcolor = "Tomato"
Case 13688896: HTMLcolor = "Turquoise"
Case 15631086: HTMLcolor = "Violet"
Case 11788021: HTMLcolor = "Wheat"
Case 16777215: HTMLcolor = "White"
Case 16119285: HTMLcolor = "WhiteSmoke"
Case 65535: HTMLcolor = "Yellow"
Case 3329434: HTMLcolor = "YellowGreen"
'******************
'* Below from web *
'******************
Case Else: HTMLcolor = "#" & Right(RngColor, 2) & Mid(RngColor, 3, 2) & Left(RngColor, 2)
End Select
ConvertToHtmlcolor = HTMLcolor
End Function
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Repost due to some of code parts was damged

PHP: 
Public Function HorAlignment(Rng)
Select Case Rng.HorizontalAlignment
Case -4108: HorAlignment = "Center"
Case -4131: HorAlignment = "Left"
Case -4152: HorAlignment = "Right"
End Select
End Function
Public Function VerAlignment(Rng)
Select Case Rng.VerticalAlignment
Case -4108: VerAlignment = "Center"
Case -4107: VerAlignment = "Bottom"
Case -4160: VerAlignment = "Top"
End Select
End Function
Public Function Orient(Rng)
Select Case Rng.Orientation
Case -4171: Orient = 90
Case -4170: Orient = -90
Case -4128: Orient = 0
End Select
End Function
Sub Email_formated()
    Dim rRange As Range
    Dim MyRange As Range
    Dim lReply As Long
     'We use On Error so we ignore run time errors
    On Error Resume Next
     'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextID, Type)
    Set rRange = Application.InputBox("With you mouse, select a range of cells.", _
    "RANGE COLLECTOR", , , , , , 8)
 
     If InStr(rRange.Address, ":") <> 0 Then
    Set MyRange = rRange
     Else
      Set MyRange = rRange.MergeArea
     End If
 On Error GoTo 0
     'Check if range is valid
    If rRange Is Nothing Then
         'If range not valid, ask if they wish to retry
        rRange = MsgBox("Non valid range. Try again?", vbOKCancel + vbQuestion)
        If rRange = vbCancel Then 'No retry
            Exit Sub
        Else 'retry
            Run "RangeAsObject"
        End If
    Else
HTMLBody = HtmlTable(MyRange, True)
End If
On Error Resume Next
Dim Start As Date
    Dim OutApp As Variant
    Dim OutMail As Variant
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
'_________________________________________________________________________________________________
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .Subject = "test"
        .HTMLBody = HTMLBody
         .Save
        .Display
     End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    On Error Resume Next
    End Sub
Sub Email_Plain()
    Dim rRange As Range
    Dim MyRange As Range
    Dim lReply As Long
     'We use On Error so we ignore run time errors
    On Error Resume Next
     'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextID, Type)
    Set rRange = Application.InputBox("With you mouse, select a range of cells.", _
    "RANGE COLLECTOR", , , , , , 8)
 
     If InStr(rRange.Address, ":") <> 0 Then
    Set MyRange = rRange
     Else
      Set MyRange = rRange.MergeArea
     End If
 On Error GoTo 0
     'Check if range is valid
    If rRange Is Nothing Then
         'If range not valid, ask if they wish to retry
        rRange = MsgBox("Non valid range. Try again?", vbOKCancel + vbQuestion)
        If rRange = vbCancel Then 'No retry
            Exit Sub
        Else 'retry
            Run "RangeAsObject"
        End If
    Else
HTMLBody = HtmlTable(MyRange, False)
End If
On Error Resume Next
    Dim OutApp As Variant
    Dim OutMail As Variant
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
'_________________________________________________________________________________________________
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .Subject = "test"
        .HTMLBody = HTMLBody
         .Save
        .Display
     End With
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    On Error Resume Next
End Sub
Public Function HtmlTable(TableRng As Range, BorderForated As Boolean)
'By: Fahad Mubark Al Dossary
Dim Rng As Range
If BorderForated = True Then
TableBorder = " class=MsoNormalTable border = 0 cellspacing=0 cellpadding=0 width=" & TableRng.Width & " style='width:" & TableRng.Width & ".0pt;margin-left:-1.15pt;border-collapse:collapse'"
Else
TableBorder = "border = 2"
End If
StrHtml = ""
StrHtml = StrHtml & ""
For Each Rng In TableRng
            RngHeight = Rng.Height
            RngWidth = Rng.Width
' If Not Intersect(Rng, Range(CellTypeVisible(TableRng))) Is Nothing Then
 If Rng.EntireColumn.Hidden = False And Rng.EntireRow.Hidden = False Then
  If Rng.Address = HeadRng(Rng) Then CreatCell = "
"
 
        If Rng.Column = FstCol(TableRng) Then
                If Rng.Address = HeadRng(Rng) Then
                StrHtml = StrHtml & "
" & CreatCell
                Else
                StrHtml = StrHtml & "
" '
                End If
        ElseIf Rng.Column = LstCol(TableRng) Then
                If Rng.Address = HeadRng(Rng) Then
                 StrHtml = StrHtml & CreatCell & "
"
                Else
                StrHtml = StrHtml & ""
                End If
        ElseIf Rng.Address = HeadRng(Rng) Then
                StrHtml = StrHtml & CreatCell
        End If
End If
Next
    StrHtml = StrHtml & "
"
 
    HtmlTable = StrHtml
End Function
Public Function TXTFMT(Rng As Range)
'By: Fahad Mubark Al Dossary
Dim I As Long
With Range(RootRng(Rng))
     Start = ""
     Length = ""
     MyCharact = ""
 
S = 1
For I = 1 To Len(.Text)
Set p = .Characters(Start:=I, Length:=1).Font
Set N = .Characters(Start:=I + IIf(I < Len(.Text), 1, 0), Length:=1).Font
    ' if Cell letters have different  color, size …..
    If .Text <> "" And ((p.Name <> N.Name) Or (p.FontStyle <> N.FontStyle) Or (p.Size <> N.Size) Or (p.Strikethrough <> N.Strikethrough) Or (p.Superscript <> N.Superscript) Or (p.Subscript <> N.Subscript) Or (p.Underline <> N.Underline) Or (p.Color <> N.Color) Or (I = Len(.Text))) Then
 
     Start = S
     Length = I - S + 1 ' Calculate Characters is the same
     S = I + 1 ' Reset Start
FontName = "font-family:" & .Characters(Start:=Start, Length:=Length).Font.Name & ";"
FontSize = "font-size:" & .Characters(Start:=Start, Length:=Length).Font.Size & ".0pt" & ";"
FontColor = "color:" & ConvertToHtmlcolor(p.Color) & ";"
 
     With .Characters(Start:=Start, Length:=Length).Font
            ' format Font
            StartFormat = IIf(.Bold = True, "", "") & IIf(.Italic = True, "", "") & IIf(.Underline = 2, "", "") & IIf(.Superscript = True, "", "") & IIf(.Subscript = True, "", "") & ""
            'Finsh format Font
            EndFormat = "" & IIf(.Subscript = True, "", "") & IIf(.Superscript = True, "", "") & IIf(.Underline = 2, "", "") & IIf(.Italic = True, "", "") & IIf(.Bold = True, "", "")
    End With
 
       Charact = StartFormat & Mid(.Text, Start, Length) & EndFormat
       MyCharact = MyCharact & Charact
        Else
 
   End If
Next I
        ' if Cell Characters have same color, size …..
    If .Text <> "" And MyCharact = "" Then
        FontName = "font-family:" & .Font.Name & ";"
        FontSize = "font-size:" & .Font.Size & ".0pt" & ";"
        FontColor = "color:" & ConvertToHtmlcolor(p.Color) & ";"
 
        StartFormat = IIf(.Bold = True, "", "") & IIf(.Italic = True, "", "") & IIf(.Underline = 2, "", "") & IIf(.Superscript = True, "", "") & IIf(.Subscript = True, "", "") & ""
        EndFormat = "" & IIf(.Subscript = True, "", "") & IIf(.Superscript = True, "", "") & IIf(.Underline = 2, "", "") & IIf(.Italic = True, "", "") & IIf(.Bold = True, "", "")
 
        Charact = StartFormat & .Text & EndFormat
        MyCharact = Charact
     End If
If .Value <> "" Then

TXTFMT = "" & MyCharact & "
"
Else
TXTFMT = ""
End If
End With
End Function
Public Function BorderFormat(TableRng As Range, Rng As Range, BorderForated As Boolean) As String
'By: Fahad Mubark Al Dossary
Dim I As Long
Dim Region As Range
Dim R As Range
Dim X As Range
 Dim EdgeTop, EdgeBottom, EdgeRight, Edgeleft, CellHeight, CellWidth, WrapText, Padding   As String
With Rng
If BorderForated = True Then
For I = 7 To 10
  If Rng.MergeCells = True And Rng.Address = HeadRng(Rng) Then
If CellRowColNo(Rng) <> "" Then
Set Region = Range(Rng.MergeArea.Address)
'Lift Side Range to find if have same color or different color, if they have different color this Edge side will have no color unless this edge is edge of Table
Lft = Cells(FstRw(Region), FstCol(Region)).Address & ":" & Cells(LstRw(Region), FstCol(Region)).Address
'Top Side range .......
tp = Cells(FstRw(Region), FstCol(Region)).Address & ":" & Cells(FstRw(Region), LstCol(Region)).Address
'Bottom Side range........
BTM = Cells(LstRw(Region), FstCol(Region)).Address & ":" & Cells(LstRw(Region), LstCol(Region)).Address
'Right Side range.......
Rght = Cells(FstRw(Region), LstCol(Region)).Address & ":" & Cells(LstRw(Region), LstCol(Region)).Address
Select Case I
Case 7: EdgeRng = Lft ' xlEdgeLeft 7  Enumeration ( Border at the left-hand edge of the range.)
Case 8: EdgeRng = tp 'xlEdgeTop 8 Enumeration ( Border at the top of the range.)
Case 9: EdgeRng = BTM 'xlEdgeBottom 9 Enumeration (Border at the bottom of the range.)
Case 10: EdgeRng = Rght 'xlEdgeRight 10 Enumeration (Border at the right-hand edge of the range.)
End Select
   Set R = Range(FstCell(Range(EdgeRng)))
End If
   On Error Resume Next
          ' MsgBox I & "  " & R.Address & "   " & Rng.Address & CellRowColNo(R) & "  " & R.Column & "  " & FstCol(TableRng) & "  " & I & "  " & 7 & (CellRowColNo(R) <> "" And R.Column <> FstCol(TableRng) And I = 7) & (CellRowColNo(R) <> "" And R.Column <> LstCol(TableRng) And I = 10) & (CellRowColNo(R) <> "" And R.Row <> FstRw(TableRng) And I = 8) & (CellRowColNo(R) <> "" And R.Row <> LstRw(TableRng) And I = 9)
         If (CellRowColNo(R) <> "" And R.Column <> FstCol(TableRng) And I = 7) Or (CellRowColNo(R) <> "" And R.Column <> LstCol(TableRng) And I = 10) Or (CellRowColNo(R) <> "" And R.Row <> FstRw(TableRng) And I = 8) Or (CellRowColNo(R) <> "" And R.Row <> LstRw(TableRng) And I = 9) Then                 'if  Merge Cells Side Edge is not side edge of Table.
         '  (CellRowColNo(R) <> "" And R.Column <> FstCol(TableRng) And I = 7) Or (CellRowColNo(R) <> "" And R.Column <> LstCol(TableRng) And I = 10) Or (CellRowColNo(R) <> "" And R.Row <> FstRw(TableRng) And I = 8) Or (CellRowColNo(R) <> "" And R.Row <> LstRw(TableRng) And I = 9)
            For Each X In Range(EdgeRng)
                If X.Borders(I).Color <> R.Borders(I).Color Then 'If  Merge Cells Edge have different color ( bisde Cells color ) unless this edge is edge of Table
                    edge = "none "
                Exit For
                Else 'If  Merge Cells Edge have one color ( bisde Cells color ) or this edge is edge of Table
                        With Rng.MergeArea
 
                        'xlLineStyle Enumeration None -4142 No line. )
                        If .Borders(I).LineStyle = -4142 Then ' if no color
                        edge = "none "
                        'XlLineStyle Enumeration (xlContinuous 1 Continuous line.)
                        ElseIf .Borders(I).LineStyle = 1 Then
                            If .Borders(I).Weight <> 1 Then
                            edge = "Solid " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                            Else
                            edge = "dotted " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                            End If
                        'XlLineStyle Enumeration (xlDot -4118 Dotted line. )
                        ElseIf .Borders(I).LineStyle = -4118 Then
                        edge = "dotted " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                        ElseIf .Borders(I).LineStyle = -4119 Then
                        edge = "double " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                        'XlLineStyle Enumeration xlDash -4115 Dashed line.)
                        ElseIf .Borders(I).LineStyle = -4115 Or .Borders(I).LineStyle = 4 Or .Borders(I).LineStyle = 5 Or .Borders(I).LineStyle = 13 Then
                        edge = "dashed " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                        End If
                End With
                End If
            Next
            Else
                        With Rng.MergeArea
 
                        'xlLineStyle Enumeration None -4142 No line. )
                        If .Borders(I).LineStyle = -4142 Then ' if no color
                        edge = "none "
                        'XlLineStyle Enumeration (xlContinuous 1 Continuous line.)
                        ElseIf .Borders(I).LineStyle = 1 Then
                            If .Borders(I).Weight <> 1 Then
                            edge = "Solid " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                            Else
                            edge = "dotted " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                            End If
                        'XlLineStyle Enumeration (xlDot -4118 Dotted line. )
                        ElseIf .Borders(I).LineStyle = -4118 Then
                        edge = "dotted " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                        ElseIf .Borders(I).LineStyle = -4119 Then
                        edge = "double " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                        'XlLineStyle Enumeration xlDash -4115 Dashed line.)
                        ElseIf .Borders(I).LineStyle = -4115 Or .Borders(I).LineStyle = 4 Or .Borders(I).LineStyle = 5 Or .Borders(I).LineStyle = 13 Then
                        edge = "dashed " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                        End If
                End With
        End If
 
         ElseIf Rng.MergeCells = False And Rng.Address = HeadRng(Rng) Then 'color unmerge cells side edge
            'xlLineStyleNone -4142 No line. )
            If .Borders(I).LineStyle = -4142 Then ' if no color
            edge = "none "
            'XlLineStyle Enumeration (xlContinuous 1 Continuous line.)
            ElseIf .Borders(I).LineStyle = 1 Then
                If .Borders(I).Weight <> 1 Then
                 edge = "Solid " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                Else
                 edge = "dotted " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
                End If
            'XlLineStyle Enumeration (xlDot -4118 Dotted line. )
            ElseIf .Borders(I).LineStyle = -4118 Then
            edge = "dotted " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
            ElseIf .Borders(I).LineStyle = -4119 Then
            edge = "double " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
            'XlLineStyle Enumeration xlDash -4115 Dashed line.)
            ElseIf .Borders(I).LineStyle = -4115 Or .Borders(I).LineStyle = 4 Or .Borders(I).LineStyle = 5 Or .Borders(I).LineStyle = 13 Then
            edge = "dashed " & ConvertToHtmlcolor(.Borders(I).Color) & " " & IIf(.Borders(I).Weight = -4138, 1 & "pt", IIf(.Borders(I).Weight = 4, 1.5 & "pt", (.Borders(I).Weight / 4) & "pt"))
            End If
        End If
 
If I = 7 Then Edgeleft = "border-Left:" & edge
If I = 8 Then EdgeTop = "border-Top:" & edge
 
If I = 9 Then EdgeBottom = "border-Bottom:" & edge
 
If I = 10 Then EdgeRight = "border-Right:" & edge
 
Next I
End If
'^
If Orient(Rng) = 90 Then '|
 FontRotate = "mso-rotate:" & 90 ' -|--->
ElseIf Orient(Rng) = -90 Then
FontRotate = "mso-rotate:" & -90
 ElseIf Orient(Rng) = 0 Then
FontRotate = "mso-rotate:" & 0
 Else
FontRotate = "mso-rotate:" & .Orientation
End If
 
If Rng.MergeCells Then
CellHeight = "height:" & Rng.MergeArea.Height
Else
CellHeight = "height:" & Rng.Height
End If
CellWidth = "Width:" & Rng.Width
If .WrapText = False Then
WrapText = " nowrap "
Else
WrapText = ""
End If
 
Background = "background:" & ConvertToHtmlcolor(Rng.Interior.Color)
Padding = "padding:0in 5.4pt 0in 5.4pt"
 
 
 End With
 'style='width:113.0pt;border:solid red 1.5/2pt;background:yellow;padding:0in 5.4pt 0in 5.4pt;mso-rotate:90;height:66.0pt'
 
BorderFormat = WrapText & VertAlig(Rng) & " cellspacing = 0 style='"
 
  Dim vItm As Variant
 Dim aStrings(1 To 9) As String
 aStrings(1) = CellWidth: aStrings(2) = EdgeTop: aStrings(3) = EdgeBottom: aStrings(4) = EdgeRight: aStrings(5) = Edgeleft: aStrings(6) = Background: aStrings(7) = Padding: aStrings(8) = FontRotate: aStrings(9) = CellHeight
  For Each vItm In aStrings
  If vItm <> "" Then
      If Txt <> "" Then
      Txt = Txt & ";" & vItm
      Else
      Txt = vItm
      End If
  End If
  Next
BorderFormat = BorderFormat & Txt & " ' >"
End Function
Public Function CellRowColNo(Rng As Range) As String
'By: Fahad Mubark Al Dossary
Dim RwPan As Long
Dim ClPan As Long
Dim RwN, ColN As String
If Rng.MergeCells Then
If Rng.Address = HeadRng(Rng) Then
 RwPan = CountUnhidRowMerRng(Range(Rng.MergeArea.Address))
 ClPan = CountUnhidColumnMerRng(Range(Rng.MergeArea.Address))
 End If
 Else
 RwPan = 1
 ClPan = 1
End If
 If RwPan > 1 Then
 RwN = " rowSpan =" & RwPan
 Else
 RwN = ""
 End If
 
 If ClPan > 1 Then
 ColN = " colspan =" & ClPan
 Else
 ColN = ""
 End If
CellRowColNo = RwN & ColN
End Function
Public Function RootRng(Rng As Range)
'By: Fahad Mubark Al Dossary
If Rng.MergeCells Then
RootRng = Left(Rng.MergeArea.Address, InStr(Rng.MergeArea.Address, ":") - 1)
Else
 RootRng = Rng.Address
End If
End Function
Public Function HeadRng(Rng As Range) As String
'By: Fahad Mubark Al Dossary
 Dim Sign As String
If Rng.MergeCells Then
RngArea = ""
RngArea = CellTypeVisible(Rng.MergeArea)
'or
'RngArea = Rng.MergeArea.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = 1 To Len(RngArea)
    If Mid(RngArea, I, 1) = ":" Or Mid(RngArea, I, 1) = "," Then
        HeadRng = Mid(RngArea, 1, I - 1)
        Exit Function
   End If
Next I
HeadRng = RngArea
Else
 HeadRng = Rng.Address
End If
End Function
Public Function HorAlign(Rng As Range) As String
'By: Fahad Mubark Al Dossary
With Range(RootRng(Rng))
Hor = HorAlignment(Range(RootRng(Rng)))
Ver = VerAlignment(Range(RootRng(Rng)))
 If Orient(Range(RootRng(Rng))) = 90 Then
HorAlign = IIf(Ver = "Top", " Align =" & "Right", IIf(Ver = "Bottom", " Align =" & "Left", " Align =" & "Center"))
 ElseIf Orient(Range(RootRng(Rng))) = -90 Then
HorAlign = IIf(Ver = "Top", " Align =" & "Left", IIf(Ver = "Bottom", " Align =" & "Right", " Align =" & "Center"))
 
 Else
 
 HorAlign = " Align =" & Hor
 
 End If
 End With
End Function
Public Function VertAlig(Rng As Range) As Variant
'By: Fahad Mubark Al Dossary
Hor = HorAlignment(Range(RootRng(Rng)))
Ver = VerAlignment(Range(RootRng(Rng)))
 If Orient(Range(RootRng(Rng))) = 90 Then
VertAlig = IIf(Hor = "Left", " Valign =" & "Top", IIf(Hor = "Right", " Valign =" & "Bottom", " Valign =" & "Center"))
 ElseIf Orient(Range(RootRng(Rng))) = -90 Then
VertAlig = IIf(Hor = "Left", " Valign =" & "Bottom", IIf(Hor = "Right", " Valign =" & "Top", " Valign =" & "Center"))
 
 Else
 VertAlig = " Valign =" & Ver
 End If
End Function
Public Function CellTypeVisible(MyRng As Range) As String
' By: Fahad Mubark Al Dossary
' to be used instead of Rng.SpecialCells(xlCellTypeVisible) in case of you want it as formula in cell
Dim Rng   As Range
Dim FstRng    As Range
Dim LstRng As Range
If InStr(MyRng.Address, ":") > 0 Then
Set FstRng = Range(Left(MyRng.Address, InStr(MyRng.Address, ":") - 1))
Else
Set FstRng = MyRng
End If
If InStr(MyRng.Address, ":") > 0 Then
Set LstRng = Range(Right(MyRng.Address, Len(MyRng.Address) - InStr(MyRng.Address, ":")))
Else
Set LstRng = MyRng
End If
Dim I, Rw, col As Long
Dim STxt, ETxt, Txt, Txt1 As String
On Error Resume Next
    For Each Rng In MyRng
        If (Rng.EntireColumn.Hidden = False And Rng.EntireRow.Hidden = False) Then
        If (Cells(Rng.Row, Rng.Column - IIf(Rng.Column = 1, 0, 1)).EntireColumn.Hidden = True Or Rng.Column = FstRng.Column) And (Cells(Rng.Row - IIf(Rng.Row = 1, 0, 1), Rng.Column).EntireRow.Hidden = True Or Rng.Row = FstRng.Row) Then
       STxt = Rng.Address
        For I = 1 To MyRng.Rows.Count
        If Cells(Rng.Row + 1, Rng.Column).EntireRow.Hidden = True Or Cells(Rng.Row, Rng.Column).Row = LstRng.Row Then
         Rw = Cells(Rng.Row, Rng.Column).Row
        ElseIf (Cells(Rng.Row + I + 1, Rng.Column).EntireRow.Hidden = True Or Cells(Rng.Row + I, Rng.Column).Row = LstRng.Row) And Cells(Rng.Row + 1, Rng.Column).EntireRow.Hidden <> True Then
        Rw = Cells(Rng.Row + I, Rng.Column).Row
 
        Exit For
        End If
         Next I
 
        For I = 1 To MyRng.Columns.Count
        If Cells(Rng.Row, Rng.Column + 1).EntireColumn.Hidden = True Or Cells(Rng.Row, Rng.Column).Column = LstRng.Column Then
         col = Cells(Rng.Row, Rng.Column).Column
        ElseIf (Cells(Rng.Row, Rng.Column + I + 1).EntireColumn.Hidden = True Or Cells(Rng.Row, Rng.Column + I).Column = LstRng.Column) And Cells(Rng.Row, Rng.Column + 1).EntireColumn.Hidden <> True Then
        col = Cells(Rng.Row, Rng.Column + I).Column
        Exit For
        End If
         Next I
          ETxt = Cells(Rw, col).Address
          If STxt <> ETxt Then
         Txt = STxt & ":" & ETxt
         Else
         Txt = STxt
         End If
        Txt1 = Txt1 & IIf(Txt1 <> "", ",", "") & Txt
        Else
        End If
        End If
 
 
    Next
    On Error GoTo 0
    CellTypeVisible = Txt1
    STxt = ""
   Txt = ""
 
End Function
Public Function FstCell(TableRng As Range) As String
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
'VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
If InStr(VisTableRng, ":") > 0 Then
For I = 1 To Len(VisTableRng)
    If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
        FstCell = Range(Mid(VisTableRng, 1, I - 1)).Address
        Exit Function
   End If
Next I
Else
FstCell = VisTableRng
End If
End Function
Public Function FstCol(TableRng As Range) As Long
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
' VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = 1 To Len(VisTableRng)
    If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
        FstCol = Range(Mid(VisTableRng, 1, I - 1)).Column
        Exit Function
   End If
Next I
End Function
Public Function LstCol(TableRng As Range) As Long
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
'VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = Len(VisTableRng) To 1 Step -1
    If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
        LstCol = Range(Mid(VisTableRng, I + 1, 99)).Column
        Exit Function
   End If
Next I
End Function
Public Function FstRw(TableRng As Range) As Long
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
'VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = 1 To Len(VisTableRng)
    If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
        FstRw = Range(Mid(VisTableRng, 1, I - 1)).Row
        Exit Function
   End If
Next I
End Function
Public Function LstRw(TableRng As Range) As Long
'By: Fahad Mubark Al Dossary
VisTableRng = CellTypeVisible(TableRng)
'or
'VisTableRng = TableRng.SpecialCells(xlCellTypeVisible).Address
Dim I As Long
For I = Len(VisTableRng) To 1 Step -1
    If Mid(VisTableRng, I, 1) = ":" Or Mid(VisTableRng, I, 1) = "," Then
        LstRw = Range(Mid(VisTableRng, I + 1, 99)).Row
        Exit Function
   End If
Next I
End Function
Public Function CountUnhidRowMerRng(MyRange As Range)
'By: Fahad Mubark Al Dossary
    Dim Rng As Range
Dim UnhCount, Count As Long
UnhCount = 0
For Each Rng In MyRange
    If Rng.MergeCells Then
        If Rng.EntireRow.Hidden = False And Rng.Column = Range(HeadRng(Rng)).Column Then
        Count = 1
        Else
        Count = 0
        End If
        UnhCount = UnhCount + Count
    End If
Next
CountUnhidRowMerRng = UnhCount
End Function
Public Function CountUnhidColumnMerRng(MyRange As Range)
'By: Fahad Mubark Al Dossary
    Dim Rng As Range
    Dim UnhCount, Count As Long
UnhCount = 0
'Myrange As Range
For Each Rng In MyRange
    If Rng.MergeCells Then
        If Rng.EntireColumn.Hidden = False And Rng.Row = Range(HeadRng(Rng)).Row Then
        Count = 1
        Else
        Count = 0
        End If
        UnhCount = UnhCount + Count
    End If
Next
CountUnhidColumnMerRng = UnhCount
End Function
Public Function ConvertToHtmlcolor(XColor As Variant)
'Excel 2010 Developer Reference > Excel Object Model Reference > Enumerations
'XlRgbColor Enumeration
'Specifies the RGB color.
'Version Information
' Version Added:  Excel 2007
 
Dim HTMLcolor, RngColor As String
RngColor = Right("000000" & Hex(XColor), 6)
Select Case XColor
Case 16775408: HTMLcolor = "AliceBlue"
Case 14150650: HTMLcolor = "AntiqueWhite"
Case 16776960: HTMLcolor = "Aqua"
Case 13959039: HTMLcolor = "Aquamarine"
Case 16777200: HTMLcolor = "Azure"
Case 14480885: HTMLcolor = "Beige"
Case 12903679: HTMLcolor = "Bisque"
Case 0:        HTMLcolor = "Black"
Case 13495295: HTMLcolor = "BlanchedAlmond"
Case 16711680: HTMLcolor = "Blue"
Case 14822282: HTMLcolor = "BlueViolet"
Case 2763429:  HTMLcolor = "Brown"
Case 8894686:  HTMLcolor = "BurlyWood"
Case 10526303: HTMLcolor = "CadetBlue"
Case 65407:    HTMLcolor = "Chartreuse"
Case 5275647:  HTMLcolor = "Coral"
Case 15570276: HTMLcolor = "CornflowerBlue"
Case 14481663: HTMLcolor = "Cornsilk"
Case 3937500:  HTMLcolor = "Crimson"
Case 9109504:  HTMLcolor = "DarkBlue"
Case 9145088:  HTMLcolor = "DarkCyan"
Case 755384:   HTMLcolor = "DarkGoldenrod"
Case 11119017: HTMLcolor = "DarkGray"
Case 25600:    HTMLcolor = "DarkGreen"
Case 11119017: HTMLcolor = "DarkGrey"
Case 7059389:  HTMLcolor = "DarkKhaki"
Case 9109643:  HTMLcolor = "DarkMagenta"
Case 3107669:  HTMLcolor = "DarkOliveGreen"
Case 36095:    HTMLcolor = "DarkOrange"
Case 13382297: HTMLcolor = "DarkOrchid"
Case 139:      HTMLcolor = "DarkRed"
Case 8034025:  HTMLcolor = "DarkSalmon"
Case 9419919:  HTMLcolor = "DarkSeaGreen"
Case 9125192:  HTMLcolor = "DarkSlateBlue"
Case 5197615:  HTMLcolor = "DarkSlateGray"
Case 5197615:  HTMLcolor = "DarkSlateGrey"
Case 13749760: HTMLcolor = "DarkTurquoise"
Case 13828244: HTMLcolor = "DarkViolet"
Case 9639167:  HTMLcolor = "DeepPink"
Case 16760576: HTMLcolor = "DeepSkyBlue"
Case 6908265:  HTMLcolor = "DimGray"
Case 6908265:  HTMLcolor = "DimGrey"
Case 16748574: HTMLcolor = "DodgerBlue"
Case 2237106:  HTMLcolor = "FireBrick"
Case 15792895: HTMLcolor = "FloralWhite"
Case 2263842:  HTMLcolor = "ForestGreen"
Case 16711935: HTMLcolor = "Fuchsia"
Case 14474460: HTMLcolor = "Gainsboro"
Case 16775416: HTMLcolor = "GhostWhite"
Case 55295:    HTMLcolor = "Gold"
Case 2139610:  HTMLcolor = "Goldenrod"
Case 8421504:  HTMLcolor = "Gray"
Case 32768:    HTMLcolor = "Green"
Case 3145645:  HTMLcolor = "GreenYellow"
Case 8421504:  HTMLcolor = "Grey"
Case 15794160: HTMLcolor = "Honeydew"
Case 11823615: HTMLcolor = "HotPink"
Case 6053069:  HTMLcolor = "IndianRed"
Case 8519755:  HTMLcolor = "Indigo"
Case 15794175: HTMLcolor = "Ivory"
Case 9234160:  HTMLcolor = "Khaki"
Case 16443110: HTMLcolor = "Lavender"
Case 16118015: HTMLcolor = "LavenderBlush"
Case 64636:    HTMLcolor = "LawnGreen"
Case 13499135: HTMLcolor = "LemonChiffon"
Case 15128749: HTMLcolor = "LightBlue"
Case 8421616:  HTMLcolor = "LightCoral"
Case 9145088:  HTMLcolor = "LightCyan"
Case 13826810: HTMLcolor = "LightGoldenrodYellow"
Case 13882323: HTMLcolor = "LightGray"
Case 9498256:  HTMLcolor = "LightGreen"
Case 13882323: HTMLcolor = "LightGrey"
Case 12695295: HTMLcolor = "LightPink"
Case 8036607:  HTMLcolor = "LightSalmon"
Case 11186720: HTMLcolor = "LightSeaGreen"
Case 16436871: HTMLcolor = "LightSkyBlue"
Case 10061943: HTMLcolor = "LightSlateGray"
Case 14599344: HTMLcolor = "LightSteelBlue"
Case 14745599: HTMLcolor = "LightYellow"
Case 65280:    HTMLcolor = "Lime"
Case 3329330:  HTMLcolor = "LimeGreen"
Case 15134970: HTMLcolor = "Linen"
Case 128:      HTMLcolor = "Maroon"
Case 11206502: HTMLcolor = "MediumAquamarine"
Case 13434880: HTMLcolor = "MediumBlue"
Case 13850042: HTMLcolor = "MediumOrchid"
Case 14381203: HTMLcolor = "MediumPurple"
Case 7451452:  HTMLcolor = "MediumSeaGreen"
Case 15624315: HTMLcolor = "MediumSlateBlue"
Case 10156544: HTMLcolor = "MediumSpringGreen"
Case 13422920: HTMLcolor = "MediumTurquoise"
Case 8721863:  HTMLcolor = "MediumVioletRed"
Case 7346457:  HTMLcolor = "MidnightBlue"
Case 16449525: HTMLcolor = "MintCream"
Case 14804223: HTMLcolor = "MistyRose"
Case 11920639: HTMLcolor = "Moccasin"
Case 11394815: HTMLcolor = "NavajoWhite"
Case 8388608:  HTMLcolor = "Navy"
Case 8388608:  HTMLcolor = "NavyBlue"
Case 15136253: HTMLcolor = "OldLace"
 Case 32896:    HTMLcolor = "Olive"
 Case 2330219:  HTMLcolor = "OliveDrab"
Case 42495:    HTMLcolor = "Orange"
Case 17919:    HTMLcolor = "OrangeRed"
Case 14053594: HTMLcolor = "Orchid"
Case 7071982:  HTMLcolor = "PaleGoldenrod"
Case 10025880: HTMLcolor = "PaleGreen"
Case 15658671: HTMLcolor = "PaleTurquoise"
Case 9662683:  HTMLcolor = "PaleVioletRed"
Case 14020607: HTMLcolor = "PapayaWhip"
Case 12180223: HTMLcolor = "PeachPuff"
Case 4163021:  HTMLcolor = "Peru"
Case 13353215: HTMLcolor = "Pink"
Case 14524637: HTMLcolor = "Plum"
Case 15130800: HTMLcolor = "PowderBlue"
Case 8388736:  HTMLcolor = "Purple"
Case 255:      HTMLcolor = "Red"
Case 9408444:  HTMLcolor = "RosyBrown"
Case 14772545: HTMLcolor = "RoyalBlue"
Case 7504122:  HTMLcolor = "Salmon"
Case 6333684:  HTMLcolor = "SandyBrown"
Case 5737262:  HTMLcolor = "SeaGreen"
Case 15660543: HTMLcolor = "Seashell"
Case 2970272:  HTMLcolor = "Sienna"
Case 12632256: HTMLcolor = "Silver"
Case 15453831: HTMLcolor = "SkyBlue"
Case 13458026: HTMLcolor = "SlateBlue"
Case 9470064:  HTMLcolor = "SlateGray"
Case 16448255: HTMLcolor = "Snow"
Case 8388352:  HTMLcolor = "SpringGreen"
Case 11829830: HTMLcolor = "SteelBlue"
Case 9221330:  HTMLcolor = "Tan"
Case 8421376:  HTMLcolor = "Teal"
Case 14204888: HTMLcolor = "Thistle"
Case 4678655:  HTMLcolor = "Tomato"
Case 13688896: HTMLcolor = "Turquoise"
Case 15631086: HTMLcolor = "Violet"
Case 11788021: HTMLcolor = "Wheat"
Case 16777215: HTMLcolor = "White"
Case 16119285: HTMLcolor = "WhiteSmoke"
Case 65535:    HTMLcolor = "Yellow"
Case 3329434:  HTMLcolor = "YellowGreen"
'******************
'* Below from web *
''******************
Case Else:     HTMLcolor = "#" & Right(RngColor, 2) & Mid(RngColor, 3, 2) & Left(RngColor, 2)
End Select
ConvertToHtmlcolor = HTMLcolor
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

mehidy1437
  • Question
Requesting for experts comments suggestion on my vba code
Replies
5
Views
687
mehidy1437
mehidy1437
W
  • Question
e-mail sheet in html and attach a spreadsheet
Replies
0
Views
637
wolthers
W
S
  • Question
Macro to filter and copy table and send mails in outlook
Replies
0
Views
2K
Sreeja
S
D
  • Question
Function will not calculate as desired reliably.
Replies
2
Views
714
DannyLee
D
P
  • Question
Vba to timestamp
Replies
2
Views
424
Pisus
P

Forum statistics

Threads
1,214,588
Messages
6,120,409
Members
448,959
Latest member
camelliaCase

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top