HTML5字体设置重影,Word怎么设置字体重影

回答：用vba实现Excel表格到CAD。下面代码供参考。

Attribute VB_Name = "模块3"

'该程序来自VBA二次开发CAD技术

Sub 根据Excel自动画表()

Dim xlApp As Excel.Application

Set xlApp = GetObject(, "Excel.Application")

Dim xlSheet As Worksheet

Set xlSheet = xlApp.ActiveSheet

Dim iPt(0 To 2) As Double

iPt(0) = 0: iPt(1) = 0: iPt(2) = 0

Dim BlockObj As ACADBlock

Set BlockObj = ThisDraWing.Blocks("*Model_Space")

Dim xlRange As Range

For Each xlRange In xlSheet.UsedRange

AddLine BlockObj, xlRange

AddText BlockObj, xlRange

Next

Set xlRange = Nothing

Set xlSheet = Nothing

Set xlApp = Nothing

End Sub

'边框处理

Sub AddLine(ByRef BlockObj As ACADBlock, ByVal xlRange As Range)

Dim rl As Double

Dim rt As Double

Dim rw As Double

Dim rh As Double

rl = xlRange.Left / 2.835

rt = xlRange.top / 2.835

rw = xlRange.Width / 2.835

rh = xlRange.Height / 2.835

Dim pPt(0 To 3) As Double

Dim pLineObj As ACADLWPolyline

If xlRange.Borders(xlEdgeLeft).LineStyle <> xlNone And xlRange.Column = 1 Then

pPt(0) = rl: pPt(1) = -rt

pPt(2) = rl: pPt(3) = -(rl + rh)

Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)

With xlRange.Borders(xlEdgeLeft)

If .ColorIndex <> xlAutomatic Then

If .ColorIndex = 3 Then

pLineObj.color = acRed

ElseIf .ColorIndex = 4 Then

pLineObj.color = acGreen

ElseIf .ColorIndex = 5 Then

pLineObj.color = acBlue

ElseIf .ColorIndex = 6 Then

pLineObj.color = acYellow

ElseIf .ColorIndex = 8 Then

pLineObj.color = acCyan

ElseIf .ColorIndex = 9 Then

pLineObj.color = acMagenta

End If

End If

If .Weight = xlThin Then

pLineObj.ConstantWidth = 0

ElseIf .Weight = xlMedium Then

pLineObj.ConstantWidth = 0.35

ElseIf .Weight = xlThick Then

pLineObj.ConstantWidth = 0.7

End If

End With

End If

If xlRange.Borders(xlEdgeBottom).LineStyle <> xlNone And (xlRange.Row = xlRange.MergeArea.Row + xlRange.MergeArea.Rows.Count - 1) Then

pPt(0) = rl: pPt(1) = -(rt + rh)

pPt(2) = rl + rw: pPt(3) = -(rt + rh)

Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)

With xlRange.Borders(xlEdgeBottom)

If .ColorIndex <> xlAutomatic Then

If .ColorIndex = 3 Then

pLineObj.color = acRed

ElseIf .ColorIndex = 4 Then

pLineObj.color = acGreen

ElseIf .ColorIndex = 5 Then

pLineObj.color = acBlue

ElseIf .ColorIndex = 6 Then

pLineObj.color = acYellow

ElseIf .ColorIndex = 8 Then

pLineObj.color = acCyan

ElseIf .ColorIndex = 9 Then

pLineObj.color = acMagenta

End If

End If

If .Weight = xlThin Then

pLineObj.ConstantWidth = 0

ElseIf .Weight = xlMedium Then

pLineObj.ConstantWidth = 0.35

ElseIf .Weight = xlThick Then

pLineObj.ConstantWidth = 0.7

End If

End With

End If

If xlRange.Borders(xlEdgeRight).LineStyle <> xlNone And (xlRange.Column >= xlRange.MergeArea.Column + xlRange.MergeArea.Columns.Count - 1) Then

pPt(0) = rl + rw: pPt(1) = -(rt + rh)

pPt(2) = rl + rw: pPt(3) = -rt

Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)

With xlRange.Borders(xlEdgeRight)

If .ColorIndex <> xlAutomatic Then

If .ColorIndex = 3 Then

pLineObj.color = acRed

ElseIf .ColorIndex = 4 Then

pLineObj.color = acGreen

ElseIf .ColorIndex = 5 Then

pLineObj.color = acBlue

ElseIf .ColorIndex = 6 Then

pLineObj.color = acYellow

ElseIf .ColorIndex = 8 Then

pLineObj.color = acCyan

ElseIf .ColorIndex = 9 Then

pLineObj.color = acMagenta

End If

End If

If .Weight = xlThin Then

pLineObj.ConstantWidth = 0

ElseIf .Weight = xlMedium Then

pLineObj.ConstantWidth = 0.35

ElseIf .Weight = xlThick Then

pLineObj.ConstantWidth = 0.7

End If

End With

End If

If xlRange.Borders(xlEdgeTop).LineStyle <> xlNone And xlRange.top = 1 Then

pPt(0) = rl + rw: pPt(1) = -rt

pPt(2) = rl: pPt(3) = -rt

Set pLineObj = BlockObj.AddLightWeightPolyline(pPt)

With xlRange.Borders(xlEdgeTop)

If .ColorIndex <> xlAutomatic Then

If .ColorIndex = 3 Then

pLineObj.color = acRed

ElseIf .ColorIndex = 4 Then

pLineObj.color = acGreen

ElseIf .ColorIndex = 5 Then

pLineObj.color = acBlue

ElseIf .ColorIndex = 6 Then

pLineObj.color = acYellow

ElseIf .ColorIndex = 8 Then

pLineObj.color = acCyan

ElseIf .ColorIndex = 9 Then

pLineObj.color = acMagenta

End If

End If

If .Weight = xlThin Then

pLineObj.ConstantWidth = 0

ElseIf .Weight = xlMedium Then

pLineObj.ConstantWidth = 0.35

ElseIf .Weight = xlThick Then

pLineObj.ConstantWidth = 0.7

End If

End With

End If

Set pLineObj = Nothing

End Sub

'文字处理

Sub AddText(ByRef BlockObj As ACADBlock, ByVal xlRange As Range)

If xlRange.Text = "" Then Exit Sub

Dim rl As Double

Dim rt As Double

Dim rw As Double

Dim rh As Double

rl = xlRange.Left / 2.835

rt = xlRange.top / 2.835

rw = xlRange.MergeArea.Width / 2.835

rh = xlRange.MergeArea.Height / 2.835

Dim iPt(0 To 2) As Double

iPt(0) = rl: iPt(1) = -rt: iPt(2) = 0

Dim mTextObj As ACADMText

Set mTextObj = BlockObj.AddMText(iPt, rw, xlRange.Text)

Dim tPt As Variant

If xlRange.VerticalAlignment = xlTop And (xlRange.HorizontalAlignment = xlLeft Or xlRange.HorizontalAlignment = xlGeneral) Then

mTextObj.AttachmentPoint = acAttachmentPointTopLeft

mTextObj.InsertionPoint = iPt

ElseIf xlRange.VerticalAlignment = xlTop And xlRange.HorizontalAlignment = xlCenter Then

mTextObj.AttachmentPoint = acAttachmentPointTopCenter

tPt = ThisDraWing.Utility.PolarPoint(iPt, 0, rw / 2)

ElseIf xlRange.VerticalAlignment = xlTop And xlRange.HorizontalAlignment = xlRight Then

mTextObj.AttachmentPoint = acAttachmentPointTopRight

tPt = ThisDraWing.Utility.PolarPoint(iPt, 0, rw)

ElseIf xlRange.VerticalAlignment = xlCenter And (xlRange.HorizontalAlignment = xlLeft _

Or xlRange.HorizontalAlignment = xlGeneral) Then

mTextObj.AttachmentPoint = acAttachmentPointMiddleLeft

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)

ElseIf xlRange.VerticalAlignment = xlCenter And xlRange.HorizontalAlignment = xlCenter Then

mTextObj.AttachmentPoint = acAttachmentPointMiddleCenter

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)

tPt = ThisDraWing.Utility.PolarPoint(tPt, 0, rw / 2)

ElseIf xlRange.VerticalAlignment = xlCenter And xlRange.HorizontalAlignment = xlRight Then

mTextObj.AttachmentPoint = acAttachmentPointMiddleRight

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh / 2)

tPt = ThisDraWing.Utility.PolarPoint(tPt, 0, rw / 2)

ElseIf xlRange.VerticalAlignment = xlBottom And (xlRange.HorizontalAlignment = xlLeft _

Or xlRange.HorizontalAlignment = xlGeneral) Then

mTextObj.AttachmentPoint = acAttachmentPointBottomLeft

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh)

ElseIf xlRange.VerticalAlignment = xlBottom And xlRange.HorizontalAlignment = xlCenter Then

mTextObj.AttachmentPoint = acAttachmentPointBottomCenter

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh)

tPt = ThisDraWing.Utility.PolarPoint(tPt, 0, rw / 2)

ElseIf xlRange.VerticalAlignment = xlBottom And xlRange.HorizontalAlignment = xlRight Then

mTextObj.AttachmentPoint = acAttachmentPointBottomRight

tPt = ThisDraWing.Utility.PolarPoint(iPt, -1.5707963, rh)

tPt = ThisDraWing.Utility.PolarPoint(tPt, 0, rw)

End If

mTextObj.InsertionPoint = tPt

Set mTextObj = Nothing

End Sub