[Ярослав Щекин]

Цитата:

Сообщение от S.Kuskov

Здорово было бы сделать конвертацию структуры отчёта из doc.* и xls.*

Я тут набросал тривиальный прототип макроса для Excel. На его основе можно сделать конвертацию структуры отчёта из .xls.

Dim CurrName As Integer

Sub Main()
Dim R As Range, c As Range

CurrName = 1
SFileName = Application.GetSaveAsFilename
Open SFileName For Output As #1

For Each c In Selection
    If c.Value <> "" Then
        Set R = c.MergeArea
        Call OutputControl(c, R)
    End If
Next c

Close #1
End Sub

Function Pt2mm(Pt As Double) As String
Pt2mm = Replace(CStr(Round(Pt * 0.352777777778, 2)) + " mm", ",", ".")
End Function

Function ConvThickness(Th As Integer) As String
Select Case Th
    Case xlHairline
    ConvThickness = "Hairline"
    Case xlThin
    ConvThickness = "pt1"
    Case xlMedium
    ConvThickness = "pt3"
    Case xlThick
    ConvThickness = "pt5"
End Select
End Function

Function ConvLine(L As Integer) As String
Select Case L
    Case xlSolid
    ConvLine = "Solid"
    Case xlNone
    ConvLine = "None"
    Case xlDash
    ConvLine = "Dash"
    Case xlDashDot
    ConvLine = "DashDot"
    Case xlDashDotDot
    ConvLine = "DashDotDot"
End Select
End Function

Sub OutputControl(TheCell As Range, CtrlRange As Range)
Print #1, "TXTFIELD"
Print #1, "  PROPERTIES"
Print #1, "    Name                #TempName" + CStr(CurrName)
Print #1, "    AutoDeclaration     #No"
Print #1, "    Left                #" + Pt2mm(CtrlRange.Left)
Print #1, "    Top                 #" + Pt2mm(CtrlRange.Top)
Print #1, "    Width               #" + Pt2mm(CtrlRange.Width)
Print #1, "    Height              #" + Pt2mm(CtrlRange.Height)
Print #1, "    TopMargin           #Auto"
Print #1, "    BottomMargin        #Auto"
Print #1, "    LeftMargin          #Auto"
Print #1, "    RightMargin         #Auto"
Print #1, "    ModelFieldName      #"
Print #1, "    ConfigurationKey    #"
Print #1, "    SecurityKey         #"
Print #1, "    Label               #"
Print #1, "    LabelLineBelow      #Solid"
Print #1, "    LabelLineThickness  #pt1"
Print #1, "    ChangeLabelCase     #Auto"
Print #1, "    ShowLabel           #No"
Print #1, "    LabelTabLeader      #Auto"
Print #1, "    LabelFont           #"
Print #1, "    LabelFontSize       #"
Print #1, "    LabelItalic         #No"
Print #1, "    LabelUnderline      #No"
Print #1, "    LabelBold           #Default"
Print #1, "    LabelCharacterSet   #0"
Print #1, "    LabelWidth          #Auto"
Print #1, "    LabelPosition       #Left"
Print #1, "    Visible             #Yes"
Print #1, "    MenuItemType        #Display"
Print #1, "    MenuItemName        #"
Print #1, "    CssClass            #"
Print #1, "    LabelCssClass       #"
Print #1, "    WebTarget           #"
Print #1, "    Text                #" + TheCell.Value
Print #1, "    TypeHeaderPrompt    #Do not append ...:"
Print #1, "    ColorScheme         #RGB"
Print #1, "    BackgroundColor     #255 255 255"
Print #1, "    BackStyle           #Opaque"
Print #1, "    ForegroundColor     #0 0 0"
Print #1, "    LineAbove           #" + ConvLine(CtrlRange.Borders(xlEdgeTop).LineStyle)
Print #1, "    LineBelow           #" + ConvLine(CtrlRange.Borders(xlEdgeBottom).LineStyle)
Print #1, "    LineLeft            #" + ConvLine(CtrlRange.Borders(xlEdgeLeft).LineStyle)
Print #1, "    LineRight           #" + ConvLine(CtrlRange.Borders(xlEdgeRight).LineStyle)
Print #1, "    Thickness           #" + ConvThickness(CtrlRange.Borders(xlEdgeLeft).Weight)
Print #1, "    Alignment           #Left"
Print #1, "    ChangeCase          #Auto"
Print #1, "    Font                #"
Print #1, "    FontSize            #"
Print #1, "    Italic              #No"
Print #1, "    Underline           #No"
Print #1, "    Bold                #Default"
Print #1, "    CharacterSet        #0"
Print #1, "    ExtendedDataType    #"
Print #1, "  ENDPROPERTIES"
Print #1, "ENDTXTFIELD"
Print #1, ""
CurrName = CurrName + 1
End Sub