Sunday, April 14, 2013

vba excel passing a dynamic number of parameter to a sub

Vba excel passing a dynamic number of parameter to a sub

I always wondered, when you program a sub and pass to it 3 parameters:

sub test(name, adress, phone)
   '=== process stuff
end sub

Then you call it several time in your program

call sub("wildboy", "555", "555-5555")

But then, you want to add one more parameter to the sub, but you have to change each line where you call the sub :(

I found how to bypass this with a type

Here is how i call a sub to format a range in excel and i can pass more or less parameters

Actually i pass the same number of parameters but shhh don't tell anyone

If i pass less parameters, i can always add a on error resume next to verify if the variable existe in the type
inside the sub

So i pass a variable of a certain TYPE to the sub

I can change the type number of variables without changing the call to the sub
and if i dont use a variable in the type in my sub, i just have to check if contain nothing

Of course by default, my sub must process empty variables of the type as a negative (0)

So the sub will process new variables i added to the type only if it contain something that will require a new processing in the sub without me having to change each line that call the sub in the main program
(read the precedent line twice if your head exploded the first time)

Tadaaaaaaaaaaaaaa!

First, define a type in excel vba:

'---------------- start code excel vba excel 2007 ALT F11 insert code


Type range_formatting_type
    '=== call rngfor(lineinside (0 or 1), rng01, linestyle (full line, half line etc), weight (thickness), color (foreground), colorindex (background))
    line_inside As Integer      '=== draw separative lines inside the range (0 = false)
    line_outside As Integer     '=== draw line outside (0 = false)
    range As Excel.range        '=== range to format and draw lines
    line_style As Integer       '=== 0 = half line
                                '=== 1 = plain line
    line_weight As Integer      '=== thickness?
    line_color As Integer       '=== line color
    cell_background As Integer  '=== colorindex, cell background color
    font_color As Integer       '=== color of letters inside the cell/range
End Type
'--------------- end code

'=== Before calling the sub, define a variable of this type:

'-------------- start code
sub main()

    Dim format01 As range_formatting_type

    format01.line_inside = 1
    format01.line_outside = 1
    Set format01.range = Excel.range(Cells(1, 1), Cells(10, 10))
    format01.line_style = 1
    format01.line_weight = 3
    format01.line_color = 1
    format01.cell_background = 35 'green
    format01.font_color = 0
 
    Call rangeformatting(format01)

end sub

'-------------- then the sub


Sub rangeformatting(format01 As range_formatting_type)
 
    'format01.line_inside = 0
    'format01.line_outside = 1
    'format01.range = rng01
    'format01.line_style = 1
    'format01.line_weight = 3
    'format01.line_color = 1
    'format01.cell_background = 35
    'format01.font_color = 0
 
    format01.range.Borders(xlEdgeLeft).LineStyle = format01.line_style
    format01.range.Borders(xlEdgeLeft).Weight = format01.line_weight
    format01.range.Borders(xlEdgeTop).LineStyle = format01.line_style
    format01.range.Borders(xlEdgeTop).Weight = format01.line_weight
    format01.range.Borders(xlEdgeBottom).LineStyle = format01.line_style
    format01.range.Borders(xlEdgeBottom).Weight = format01.line_weight
    format01.range.Borders(xlEdgeRight).LineStyle = format01.line_style
    format01.range.Borders(xlEdgeRight).Weight = format01.line_weight
 
    If format01.line_inside = 1 Then
        format01.range.Borders(xlInsideVertical).LineStyle = format01.line_style
        format01.range.Borders(xlInsideVertical).Weight = format01.line_weight
        format01.range.Borders(xlInsideHorizontal).LineStyle = format01.line_style
        format01.range.Borders(xlInsideHorizontal).Weight = format01.line_weight
    Else
        format01.range.Borders(xlInsideVertical).LineStyle = Excel.XlLineStyle.xlLineStyleNone
        'rrng01.Borders(xlInsideVertical).Weight = 2
        format01.range.Borders(xlInsideHorizontal).LineStyle = Excel.XlLineStyle.xlLineStyleNone
        'rrng01.Borders(xlInsideHorizontal).Weight = 2
 
    End If
    '=== green
    'col01 = &H10C010
 
    format01.range.Borders(xlEdgeLeft).Color = format01.line_color
    format01.range.Borders(xlEdgeTop).Color = format01.line_color
    format01.range.Borders(xlEdgeBottom).Color = format01.line_color
    format01.range.Borders(xlEdgeRight).Color = format01.line_color
 
    format01.range.Interior.ColorIndex = format01.cell_background
End Sub

'----------------- end code



Monday, April 8, 2013

excel generating a drawing of a frame with precision

Writing about my code is a brain storming that make me think more about it

coding is like scuba diving: the more you think about it, the deeper you go

so, at our compagny, we use frames in autocad to enclose drawing with information about name, revision, ingeneer signatures etc.

but not everyone use autocad on a daily basis

so we needed to reproduce a frame, of each format: a0, a1, a2, a3 that will contain information for the floor work in a factory

we did not want multiples pages. that is why there is 4 different size

the goal is to:
take a table from sheet1 (soushe = source sheet)
generate a frame in paper format a3 (based in acrobat pdf printer)
try to fill the frame with the date contained in the source sheet
if the a3 is too small, rebuild the frame with a2, a1, and finally a0 if it is still too small to fit in one sheet

the difficulties are:
the source sheet always have multiple columns
each line can be short or long, we cannot cut the line when we put them in the destination sheet with the frame (shedes = sheet destination)
so some line will be double or even triple

the destination sheet will be pixelised
each line will have a normal height, but will be expanded in height (double heaight, triple etc.) if the line from the source sheet have too much text
but this must be done with an average of the width of the letters, as M is larger than I
and finally, is i double the height and the text still dont fit, i must add height

her is an image of the corner of the frame generated:


as you can see the line height are smaller where the frame info is

the column is a pixel large only and lots of merge are done

now my goal is to automate the filling of the line that are just above the frame




news sharepoint 2013 recursive managed term creation

Hello,

i did the conversion array vbs to sql in one table

the past few months i worked on a jagged array in vb.net 2012 (in vs 2012)

usually, a jagged array only contain arrays in vb.net
but i needed more, i needed string followed by an array to be able to use recursiveness
so the code call itself when it encounter an array, but continue when it encounter a string
if you use object type, you can do a jagged array containing string and arrays

so i used this mixed jagged array to create terms in sharepoint 2013

the array of objects looked like this: (vb.net)

the GUID in the brackets are unique GUID wich i use to create sharepoint terms
note: arapro is another array with project terms

note: arasec is an array with sectors in our enterprise
as we want to "tag" our files with the product type, the sector, if it's a model or reference, and finally, what type of realisator did it

i wanted fixed GUID because when you redo all because the term tree change, you want to preserve the link the files (or any library object) have with the term tree

                Dim ara01() As Object = {"STAS {C0C329A0-1881-4C49-A5D4-0ED0E02259C5}", _
                    New Object() {"ProjetsStas {620BAB20-C4D1-4FD1-9782-BF981EFF4BC3}", _
                        New Object() {"224235_Produits {" & termGUId224235.ToString & "}", _
                            New Object() {"Type {7532C15C-F12B-4650-B55A-F00F17EB45A6}", _
                                New Object() {"Modèle {A4385F1E-69B4-4BEA-ABAA-4F40B7488E55}", "Référence {2092E26E-AB98-4581-92E4-9B658C5BD73B}"}}, _
                            New Object() {"Réalisateur {A7E95AD4-1827-4B46-9947-81986B69DBCD}", _
                                New Object() {"Ing. {44970D98-D53D-4538-ACFD-4A811299AE30}", "Produit {267A4178-C37C-486F-93C1-73DA6EE7C803}", "Mec {6FEA1110-A7D3-4C19-A037-3819436952BF}"}}, _
                            New Object() {"Produit {9A3E07FB-A893-47C8-8003-FBE10546E694}", arapro}, _
                            New Object() {"Secteur {FF26A0AF-B8EF-4542-B9A2-F3B8D35E9A23}", arasec} _
                        } _
                    } _
                }



the code is recursive and call itself when it encounter an array inside the initial array

you have to create the initial term group before calling on the recusrsiveness, so the object passed to the recursive call is a sub array

code must be run on sharepoint server

Call recurterms(ara01(1)(1), term, site, lang, store)

recursive sub that create a term tree according to a jagged/string array:

---------------- vb.net vs 2012 code ---------------- recursive call to create term tree in sharepoint


    Sub recurterms(aara As Object, tterm As Microsoft.SharePoint.Taxonomy.Term, ssite As Object, lang As Integer, ByRef termstore As Taxonomy.TermStore)
        Dim eelelef As String
        Dim eeleguid As String
        Dim nnewTermId As Guid
        Dim ttermbefore As Microsoft.SharePoint.Taxonomy.Term

        '=== this sub is recursive
        '=== aara is an array of objects that can contain a string or an array (up to infinite level of depth)
        '=== tterm is a term object (not a group, not a termset)
        '=== ssite if the sharepoint site (not used for now)

        '=== sublvl is a GLOBAL variable so it is the same in all recursiveness
        Dim tot As Integer
        Dim caca As Object
        For Each caca In aara
            tot = tot + 1
        Next

        Dim ii As Integer = 0
        For Each eele In aara

            If Not IsArray(eele) Then
                '=== skip first element because it is the name (As string) of the group that contain the sub groups (Array)
                '                If InStr(eele, "MSDS") <> 0 Then
                'MsgBox(tterm.Name)
                'End If
                If Not (sublvl = 0 And ii = 0) Then
                    If InStr(eele, "{") <> 0 Then
                        eelelef = Mid(eele, 1, InStr(eele, "{") - 2) '=== left part of this element - name only
                        eeleguid = Mid(eele, InStr(eele, "{"), InStr(eele, "}") - InStr(eele, "{") + 1)
                        nnewTermId = New Guid(eeleguid)
                    Else
                        '=== generate a new guid because it was not with the name enclosed in {}
                        eelelef = eele
                        nnewTermId = Guid.NewGuid()
                    End If
                    'MsgBox(sublvl & vbCrLf & IsNothing(tterm) & vbCrLf & eelelef)
                    objfil03.WriteLine(New String(" ", sublvl * 3) & "sublvl:" & sublvl & "---" & eelelef)
                    ttermbefore = tterm.CreateTerm(eelelef, lang, nnewTermId)
                    'termstore.CommitAll()

                End If
                ii = ii + 1
            Else
                '=== the object is an array, we recursively call this same sub, incrementing the depth level (sublvl)
                sublvl = sublvl + 1
                ii = ii + 1
                If IsNothing(ttermbefore) Then ttermbefore = tterm
                'objfil03.WriteLine(eele.count)
                Call recurterms(eele, ttermbefore, ssite, lang, termstore)
            End If

        Next
        sublvl = sublvl - 1

    End Sub
---------------------


i am not posting the whole code, as this is a job project, not a personal project

coding this was not hard, but a little long to find the right objects to use to manipulate sharepoint
(expecially the ones to apply multiple managed terme to a file i just imported from ntfs)

after this, i made another code to import files in sharepoint 2013 and tag the file with multiple managed terms
that was very tricky as i saw no such code in vb, outside sharepoint
this code is a command line compilation in vb.net 4.5 with  visual studio 2012 for sharepoint 2013

i doubt anyone but a real pro will be interested in such advanced stuff

but if you are interested in the whole code, i might write an article on expert exchange

most of the codes that can do this on internet are not free, and without the source :(

the goal is to migrate all our file system in sharepoint adn use managed metadata to tag all files and be able to find them from different perspectives in the term tree (by product, by sector etc)

also sharepoitn 2013 approval and versionning major and minor are very attractives :)

we plan to do a library for each product
some view to be able to reach documents cross library
a reference library with no approval where we can see all drafts
the product library will have view to see product file and references from other library where draft can be seen