Thursday, November 19, 2009

Tundra Ski Doo For Sale In Ontario

Organization - Excel 2003 UDF

the file can be downloaded by clicking here

Warning! for the proper functioning of the file is saved

, in fact, contains additional references.

Excel Version 2003

Contains macros - References added to:

Microsoft Windows Common Controls 6.0 (SP &)

  • Microsoft Scripting Runtime
    TreeView and Spreadsheet ( an initial message will ask you to enable ActiveX controls)

Description:

All''apertura file is created Bar not anchored with two buttons. The first "Wizard" recalls

the Forms to build an organization and modification of existing charts in spreadsheets saved as a data source whose name is preceded by or O_P_ O_.

The second refers to a form that helps in adding nodes directly to a spreadsheet data source.

The creation of organization charts is simplified by using a TreeView that helps you see the classic tree are also present options for editing, deleting, adding or moving nodes.

A Form that contains a Spreadsheet allows you to add more nodes to a single parent.

Each node is associated with two text fields longer be able to choose whether the node is a person or a collaborator. The creation of hierarchical diagrams provides the possibility to organize the field of individual text boxes, thanks to a dedicated form.

E 'can create diagrams in a Word document, a PowerPoint presentation or a new worksheet or a new Excel workbook.

E 'can choose the layout of the first node and the subsequent nodes.

Organization very large produce diagrams difficult to visualize, so as an organization is able to isolate a single branch and treat it separately.

Saving data that is the organization or branch block is allowed in two formats, Excel spreadsheet and two XML files. This second option is very experimental and probably more a curiosity than a real utility, however the format

XML 2D transforms the organization into a table that later reopened as a list in Excel will show the organization as a normal table where each column is always an outer layer of the structure.

Il formato XML 3D invece crea uno schema analogo alla visualizzazione nella TreeView.

Nel foglio Esempio1 viene mostrato come creare un foglio di Origine del tipo O_P_ a partire da una semplice tabella.

Nel foglio Esempio2 viene mostrato come è possibile usare un elenco di path per generare un Organigramma.

I fogli con prefisso E_ vengono utilizzati come elenchi di nodi da organizzare nella creazione dell'organigramma. Di questi fogli viene estratto l'elenco univoco dei testi e reso disponibile nella combo di assegnazione del nuovo nodo, una volta aggiunto il nodo la voce viene eliminata dalla combo. E' anche possibile copiare in for example, a series of memory cells and get the same result. If the memory is occupied by a text list will be created with the single word length of 4 characters.

To learn how to use this tool the best way is to create an organization from scratch, play, save, reopen and change the data source. The sheets in the folder are already created data sources with which you can do tests. In particular

sheets Modello_Oggetti reconstruct the pattern of the model of Office applications. This folder is likely to be transformed into a component additional saving it as XML.

The project code is commented, the routines were divided into 3 modules for clarity in reading. The form of the code is commented only partially. The functions in the module functions are very general and reusable, the board then read them carefully.

greetings

r

Wednesday, November 18, 2009

Funny Red Spot On Breast

Join

The CONCATENATE function in Excel has many limitations, you can not use formulas with matrix, you can not pass a range of multiple cells ... the UDF MCAT Harlan Grove solves these problems so dear, a really good feature. Basically it's a chain with the characteristics of the SUM function, and then accepts an arbitrary number of parameters, which can be represented by the range of multiple cells ... can also be used in a feature matrix, really cool ... here it is: Function

MCAT (ParamArray S ()) As String

'Copyright (C) 2002, Harlan Grove ' This is free software. It's use in derivative works is covered 'under the terms of the Free Software Foundation's GPL. See

'http://www.gnu.org/copyleft/gpl.html

'------------------------------------

'string concatenation analog to SUM Dim R As Range, x As Variant, y As Variant

If TypeOf x Is Range Then
For Each R In x.Cells
mcat = mcat & R.Value Next R
ElseIf IsArray(x) Then
For Each y In x
mcat = mcat & IIf(IsArray(y), mcat(y), y)
Next y
Else
mcat = mcat & x
End
If Next x End Function








I drew inspiration from this function to create a UDF like to extremely useful to Join VB ... JoinUDF returns a string created from the combination of substrings contained in the source parameter is bounded by the parameter delimiter.


Source will be a range of more cells or an array, delimiter can be any value or range or an array (in this case is the concatenation of substrings).


Like Join this feature can be used to concatenate strings, omitting it will be used as a delimiter Delimiter string length zero (la funzione Join viceversa usa come defoult lo spazio).


Function JoinUDF( _
Source As Variant, _ Optional Delimiter As Variant = "") As String
'di Roberto Mensa Nick r Dim Rng As Range, x() As String, y As Variant Dim i As Long
If TypeName(Source) = "Range" Then ReDim x(Source.Count - 1)
For Each Rng In Source
x(i) = CStr(Rng.Value) i = i + 1 Next
ElseIf IsArray(Source) Then For Each y In Source
ReDim Preserve x(i)
x (i) = CStr (IIf (IsArray (y), JoinUDF (y), y))
i = i + 1 Next


Else ReDim x (0)
x (0) = CStr (Source) End
If

If IsArray (Delimiter) Or TypeName (Delimiter) = "Range" Then Delimiter =
JoinUDF (Delimiter) End If

JoinUDF = Join (x, CStr (Delimiter)) End Function




greetings
r


Wednesday, November 4, 2009

Gift Card Shower Wording

Dashboard Charts (Excel )

Lately I'm impassioning the dashboard charts ... type tacchimetro car :-)
attach two files, I added a throttle effect, the macros only affect this ... for the rest work with ordinary Excel functions

Link 1 Link 2





greetings r

Nikon Digital Camera Battery Use Cold

Osvaldo Cavandoli - Scatter charts (Excel)

After Cavandoli Test ... for those who want to practice with the scatter plots ... some pictures of the line of the legendary Osvaldo Cavandoli ... Link to file


greetings r

Tuesday, November 3, 2009

Pool Table Minimum Clearances

prime factorization (VB)

Two agile functions for prime factorization of a number. Greetings
r


Dim T As Long Dim R As Long Dim S As String

'is based on the principle that a number R = Sqr(N)
T = N Mod 2 + 1
F = 1
If N = 1 Then S = N
Else
Do Until F > R
F = F + T
If (N) Mod F = 0 Then
S = S & F & "*"
N = N / F
F = F - T
R = Sqr(N)
End If
Loop
If N = 1 Then
S = Left(S, Len(S) - 1)
Else
S = S & N
End If
End If

Fattori_primi = S
'volendo una matrice sostituire con
'Fattori_primi = Split(S, "*")

End Function


Public Function PrimiB2(ByVal N As Long) As Long()
'di Nur
Dim arrF() As Long
Dim F As Long, NP As Long, d As Long
Dim Stp As Long, Radice As Long
If N = 1 Then
ReDim arrF(0)
arrF(0) = 1
Else
Radice = Sqr(N)
d = 1
Stp = N Mod 2 + 1
Do Until d > Radice
d = d + Stp
If N Mod d = 0 Then
NP = NP + 1
ReDim Preserve arrF(NP - 1)
arrF(NP - 1) = d
N = N / d
d = d - Stp
Radice = Sqr(N)
End If

If Loop ReDim Preserve arrF
d (NP)
arrF (NP) = N
ElseIf d = 1 Then ReDim
arrF (0)
arrF (0) = N
End If End If

PrimiB2 = arrF
End Function



Sore Spot Stomach Pregnant

TextBox with validation data (MSForm - VBA - VBScript)

text boxes (TextBox) are among the controls used in the creation of the UserForm. They are suitable for data visualization, but they are often used to gather input. In this regard it is worth specifying that the data that are defendants in the TextBox are text or string data. Problems arise when you want to enter different data types, such as dates or numbers. In these cases it is always good contralateral placing no validation of the data.
propose an example that uses regular expressions to check if the data was written correctly. The check is done and Exit event uses a generic routine that is passed to the pattern. I preferred writing to alert you in a Label control any error message, rather than using annoying error messages.
< N Then


'xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
' for example, inserting a new


'UserForm (UserForm1) containing:
' a Label (Label1) and three TextBox
'other path can be found at:
' http://excelvba.altervista.org/blog/index.php/Excel-VBA/Espressioni-Regolari-e-Pattern-applicazione-Form.html


' Paste all the code in the form

'class of

userform Private Sub UserForm_Initialize () With Me
. Caption = "Sample TextBox with validation
. Label1.Caption =" "
. Label1.ForeColor = & HFF &
. TextBox1.Tag = "European Data"
. TextBox2.Tag = "Tax Code"
. TextBox3.Tag = "Decimal" . TextBox1.Text = "12/10/2009" . TextBox2 . Text = "DVXJHT61B12Z600F"
.TextBox3.Text = "2,5" End With End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'data europea
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox1, _
Cancel, _
"^(3[01][12]\d0?[1-9])/(0?[13578]1012)/" &amp; _
"(\d{2}(192021)\d{2})$" &amp; _
"^(30[12]\d0?[1-9])/(0?[469]11)/(\d{2}" &amp; _
"(192021)\d{2})$" &amp; _
"^(2[0-8][01]\d0?[1-9])/(0?2)/(\d{2}" &amp; _
(192,021) \\ d {2}) $ "& _
" ^ 29 / (0? 2) / (200000) $ "& _
" ^ 29 / (0? 2) / (192 021) ? (0 [48] [2468] [048] "& _
[13579] [26]) $"
End Sub Private Sub

TextBox2_Exit (ByVal Cancel As MSForms.ReturnBoolean)
'tax code
UserForm_Controllo_Event_Exit Me . Label1,
Me.TextBox2 _, _
Cancel,
_ "^ ([AZ] {6})" & _
"(((\\ d {2}) [ACELMRT] (3 [01] [12 ] \\ d0 [1-9] "& _
" 7071 [56] \\ d4 [1-9])) "& _
" ((\\ d {2}) [DHPS] (30 [12] \\ d0 [1-9] 70 " &amp; _
"[56]\d4[1-9]))" &amp; _
"((\d{2})B(2[0-8]1\d0[1-9]6[0-8]5\d4[1-9]))" &amp; _
"((0[048][2468][048][13579][26])B(2969)))" &amp; _
"([A-Z]{1})([0-9L-NPQ-V]{3})" &amp; _
"([A-Z]{1})$"

End Sub

Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'numero a virgola mobile
UserForm_Controllo_Event_Exit Me.Label1, _
Me.TextBox3, _
Cancel, _
"^(0[+-]?" &amp; _
"((?!0)\d+([,]\d+)?" &amp; _
"[0]+([,]\d+)?))$"

End Sub


Sub UserForm_Controllo_Event_Exit( _
ByRef oLabel As MSForms.Label, _
ByRef oControl As MSForms.Control, _
ByRef Cancel As MSForms.ReturnBoolean, _
Optional ByVal sPattern As String = "[\w\s]+")
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Effettua un controllo sul testo digitato in un
'controllo, se il controllo ha esito negativo
'ripassa cancel=true impedendo l'uscita del focus
'e seleziona l'intero testo digitato
'da richiamare dall'evento exit di controlli che
'hanno cancel come argomento
'oLabel è il controllo Label entro cui comunicare
'il messaggio di errore

Dim re As Object
Static sLabelCaption As String
Static bCancel As Boolean

If bCancel = False Then
sLabelCaption = oLabel.Caption
End If

Set re = CreateObject("vbscript.regexp")
re.Pattern = sPattern
re.ignorecase = True
With oControl
If Len(.Text) > 0 Then
If re.test(.Text) = False Then
oLabel.Caption = _
"Testo " &amp; .Tag &amp; " - Non valido!"
.SelStart = 0
.SelLength = Len(.Text)
Cancel = True
bCancel = True
End If
End If

If End With Cancel = False Then
bCancel = False
oLabel.Caption = sLabelCaption
End If End Sub




Monday, November 2, 2009

What Should I Wear For My Birthday Dinner??

CSV for each sheet in the active Excel workbook (Excel - VBA)

The code that I propose is to create, starting from data contained in the sheets in a workbook, a series of csv file (or txt).
The Save As file of this type in fact carried out by VB code does not recognize decimal delimiters incorrectly, so the comma is replaced by point ...
is used a reference library to use the Scripting FileSystemObject.
to get the huge potential of the FSO will find many examples in the help of VBScript. Leditor VBScript accessible from the menu Tools-> Macro> Microsoft Script Editor ... (You may need to install the first access to any OK) ... Editor online help is then available chapter vbscript within which you will find topics related to the FileSystemObject. Greetings

r





Option Explicit 'in a standard form of the VBA project ' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Di Roberto Mensa nick r
'______________________________________________
'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'crea per ogni foglio della cartella di lavoro
'un file csv o txt (modificando la costante
'Estensione_file)
'i file vengono salvati nel percorso nella stessa

'posizione della cartella attiva 'se un file csv con lo stesso percorso-nome esiste 'già sarà sovrascritto
Dim Sh As Excel.Worksheet
Dim Rng As Excel.Range
Dim S As String
Dim FSO As Object
Dim tS As Object
Dim Wb As Excel.Workbook
Dim sPath As String
Const ForWriting As Long = 2
Const Estensione_file As String = ".csv"
Set Wb = ActiveWorkbook

Set FSO = CreateObject("Scripting.FileSystemObject")
sPath = Wb.Path '
On Error Resume Next
For Each Sh In Wb.Worksheets
Set Rng = UsedRange_Value(Sh, , True)
S = CSV_text(Rng)
Set tS = FSO.OpenTextFile(FSO.BuildPath( _
sPath, Sh.Name &amp; Estensione_file _
), ForWriting, True)
tS.Write S
tS.Close
Next
End Sub
Function CSV_text( _
Rng As Excel.Range, _ Option D
As String = "") As String '
'______________________________________________ << eventualmente da cambiare
¯¯¯¯¯¯¯¯¯¯¯¯¯
'by Robert Mensa nick r
'______________________________________________
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'parameter opzionale D indica il delimitatore
'da utilizzare nella scrittura del file
Dim R As Long, C As Long
Dim S As String, St As String

For R = 1 To Rng.Rows.Count
St = ""
For C = 1 To Rng.Columns.Count
St = St &amp; D &amp; Rng(R, C).Text
Next C
If Len(Replace(St, D, "")) Then
St = Right(St, Len(St) - 1)
Else
St = ""
End If
S = S &amp; St &amp; VBA.Constants.vbNewLine
Next R

CSV_text = VBA.Left(S, Len(S) - 2)
End Function
Function UsedRange_Value( _
Optional Sh As Worksheet, _
Optional Rng As Range, _
Optional WithFormulas As Boolean = False) _ As Excel.Range


'______________________________________________
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'by Robert Mensa nick r
'______________________________________________
' ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
'Returns the minimum range rectangular
' which includes all cells enhanced
'in sheet or in the range that we spend as
' argument

'Returns Nothing if no cell is
' enhanced

'will be ignored by passing Sh Rng

'not passing arguments will be sought
' active sheet in the range of
folder 'containing only the cells that contain active
' a constant value

'passing will
WithFormulas = True' also considered the cells with a
'formula

Dim S As String, ts As String Dim
RE As Object Dim
maxrate As Long Dim maxc
minR As Long As Long, Mincio As Long Dim V


'Check for the first two arguments and septum
' If the search range
Sh
Is Nothing Then If Rng Is Nothing Then
September Rng = [a1]. Parent.UsedRange
End If
September Sh = Rng.Parent
= Rng Else
September Sh.UsedRange
End If On Error Resume Next


'sets the range of cells containing a value
' constant
September UsedRange_Value Rng.SpecialCells = (_
xlCellTypeConstants)

' Control If the optional parameter
WithFormulas
Then 'add the cells that contain formulas
If TypeName (UsedRange_Value) = "Nothing" Then
September UsedRange_Value = _
Rng.SpecialCells (xlCellTypeFormulas, 23)
Else
September UsedRange_Value = _
Union (
UsedRange_Value _, _
Rng.SpecialCells (xlCellTypeFormulas, 23))

End If End If On Error GoTo 0


'verification that the range is not empty If
TypeName (UsedRange_Value) = "Range" Then
'I check if it contains more areas
If UsedRange_Value.Areas.Count> 1 Then
' recovery
set the coordinates to 'rectangular range
' Warning!
'behavior is not documented
' Address reported to range
'Rng.Address returns up to 257
' characters
For Each V In UsedRange_Value
S = S & V. _
Address (True, True, xlR1C1)
Next
Set RE = CreateObject("vbscript.regexp")
RE.Global = True

RE.Pattern = "C\d+:,"
tS = RE.Replace(S, "")

RE.Pattern = "\d+"
maxR = RE.Execute(tS)(0)
minR = maxR
For Each V In RE.Execute(tS)
If V
minR = V
ElseIf V > maxR Then
maxR = V
End If
Next

RE.Pattern = "R\d+:,"
tS = RE.Replace(S, "")

RE.Pattern = "\d+"
maxC = RE.Execute(tS)(0)
minC = maxC
For Each V In RE.Execute(tS)
If V
minC = V < minR Then
ElseIf V > maxC Then
maxC = V
End If Next

September UsedRange_Value Sh.Range = (_
Sh.Cells (minR, Mincio), _
Sh.Cells (maxrate, maxc))

End If End If End Function




< minC Then