From bf86f58873cf7011088ba9e95f3cd4d4027fd182 Mon Sep 17 00:00:00 2001 From: cugit Date: Fri, 27 Jan 2012 22:16:48 -0300 Subject: [PATCH] Generic Tools --- Collection/Modules/ModCollection.bas | 27 ++++++++++++++ Database/Modules/ModInsert.bas | 43 ++++++++++++++++++++++ Generic/Modules/ModAdvance.bas | 28 ++++++++++++++ Generic/Modules/ModPaste.bas | 34 +++++++++++++++++ Generic/Modules/ModStrings.bas | 55 ++++++++++++++++++++++++++++ 5 files changed, 187 insertions(+) create mode 100644 Collection/Modules/ModCollection.bas create mode 100644 Database/Modules/ModInsert.bas create mode 100644 Generic/Modules/ModAdvance.bas create mode 100644 Generic/Modules/ModPaste.bas create mode 100644 Generic/Modules/ModStrings.bas diff --git a/Collection/Modules/ModCollection.bas b/Collection/Modules/ModCollection.bas new file mode 100644 index 0000000..ff55cbb --- /dev/null +++ b/Collection/Modules/ModCollection.bas @@ -0,0 +1,27 @@ +Attribute VB_Name = "ModCollection" +'''''''''''''''''''''''''''''''''''''''''''' +'' VBA Excel Tools '' +'' Gabriel CUGLIARI '' +'' Abr 2011 '' +'''''''''''''''''''''''''''''''''''''''''''' + +''=== JoinRange === +' +'=JoinRange(;) +'=JoinRange(A1:G1;";") +' +Public Function JoinRange(Rng As Range, separator As String) As String + + Dim nRow As Integer + + If Not Rng Is Nothing And Rng.Rows.Count = 1 Then + nRow = Rng.Columns.Count + JoinRange = "" + For ii = 1 To nRow + JoinRange = JoinRange & IIf(ii > 1, separator, "") & Trim(Rng(1, ii)) + Next + Else + JoinRange = "(null)" + End If + +End Function diff --git a/Database/Modules/ModInsert.bas b/Database/Modules/ModInsert.bas new file mode 100644 index 0000000..6eab185 --- /dev/null +++ b/Database/Modules/ModInsert.bas @@ -0,0 +1,43 @@ +Attribute VB_Name = "ModInsert" +'''''''''''''''''''''''''''''''''''''''''''' +'' VBA Excel Tools '' +'' Gabriel CUGLIARI '' +'' Abr 2011 '' +'''''''''''''''''''''''''''''''''''''''''''' + + +''=== genInsertSentence === +' +Public Function genInsertSentence(ByRef Rng As Range, Optional head As String = "", Optional tail As String = "") As String + + Dim cc As Integer + Dim Line As String + + If Rng.Rows.Count <> 1 Then + genInsertSentence = "Invalid Row Count" + Exit Function + End If + + Line = "" + For cc = 1 To Rng.Columns.Count + + Line = Line & IIf(Len(Line) = 0, "(", ", ") + xx = VarType(Rng(1, cc)) + Select Case VarType(Rng(1, cc)) + Case 8: ''String + Line = Line & "'" & Trim(Rng(1, cc)) & "'" + Case 5: ''Number + Line = Line & Trim(Rng(1, cc)) + Case 7: ''Date + Line = Line & "'" & Format(Rng(1, cc), "yyyy-mm-dd") & "'" + Case 0: ''Celda vacia + Line = Line & "NULL" + Case Else: + Line = Line & "'" & Trim(Rng(1, cc)) & "'" + End Select + Next cc + + Line = IIf(Len(head) > 0, head & " ", "") & Line & ")" & tail + genInsertSentence = Line + +End Function diff --git a/Generic/Modules/ModAdvance.bas b/Generic/Modules/ModAdvance.bas new file mode 100644 index 0000000..53cd114 --- /dev/null +++ b/Generic/Modules/ModAdvance.bas @@ -0,0 +1,28 @@ +Attribute VB_Name = "ModAdvance" +'''''''''''''''''''''''''''''''''''''''''''' +'' VBA Excel Tools '' +'' Gabriel CUGLIARI '' +'' Abr 2011 '' +'''''''''''''''''''''''''''''''''''''''''''' + +''=== RangeFillPercert === +' +Public Function RangeFillPercert(ByRef Rng As Range) As Integer + + Dim Total As Long + Dim Acc As Double + + Acc = 0 + Total = Rng.Columns.Count * Rng.Rows.Count + + For cc = 1 To Rng.Columns.Count + For rr = 1 To Rng.Rows.Count + If VarType(Rng(rr, cc)) > 0 Then + Acc = Acc + 1 + End If + Next rr + Next cc + + RangeFillPercert = Int((Acc * 100) / Total) + +End Function diff --git a/Generic/Modules/ModPaste.bas b/Generic/Modules/ModPaste.bas new file mode 100644 index 0000000..3be8117 --- /dev/null +++ b/Generic/Modules/ModPaste.bas @@ -0,0 +1,34 @@ +Attribute VB_Name = "ModPaste" +Sub PasteValues() +Attribute PasteValues.VB_ProcData.VB_Invoke_Func = "v\n14" +' +' PasteValues Macro +' + +On Local Error GoTo PasteValues_err + + If Application.CutCopyMode Then + Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False + Else + ActiveSheet.PasteSpecial Format:="Texto", Link:=False, DisplayAsIcon:=False + ''ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False + End If + + ''Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ + :=False, Transpose:=False + + ''ActiveSheet.PasteSpecial Format:="Texto", Link:=False, DisplayAsIcon:=False +PasteValues_err: + +End Sub + + +''Application.OnKey "^v", "DoMyPaste" + +Public Sub DoMyPaste() + If Selection.[is marked cell] Then + Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False + Else + ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False + End If +End Sub diff --git a/Generic/Modules/ModStrings.bas b/Generic/Modules/ModStrings.bas new file mode 100644 index 0000000..2f91e5d --- /dev/null +++ b/Generic/Modules/ModStrings.bas @@ -0,0 +1,55 @@ +Attribute VB_Name = "ModStrings" +'''''''''''''''''''''''''''''''''''''''''''' +'' VBA Excel Tools '' +'' Gabriel CUGLIARI '' +'' Abr 2011 '' +'''''''''''''''''''''''''''''''''''''''''''' + +''=== CleanString === +' +' +Public Function CleanString(Cadena As String) As String + + + CleanString = Trim(Cadena) + + Do While InStr(1, CleanString, " ") + CleanString = Replace(CleanString, " ", " ") + Loop + + CleanString = UCase(CleanString) + + CleanString = Replace(CleanString, "Á", "A") + CleanString = Replace(CleanString, "É", "E") + CleanString = Replace(CleanString, "Í", "I") + CleanString = Replace(CleanString, "Ó", "O") + CleanString = Replace(CleanString, "Ú", "U") + CleanString = Replace(CleanString, "Ü", "U") + CleanString = Replace(CleanString, "Ñ", "#") + + CleanString = Replace(CleanString, "°", ".") + CleanString = Replace(CleanString, "ª", ".") + CleanString = Replace(CleanString, "~", "-") + CleanString = Replace(CleanString, Chr(150), "-") + + CleanString = Replace(CleanString, "Ö", "O") + CleanString = Replace(CleanString, "Ç", "C") + CleanString = Replace(CleanString, "Æ", "AE") + CleanString = Replace(CleanString, "Ç", "C") + +End Function + +''=== ExtractUntil === + +Public Function ExtractUntil (txt As String, char As String) + + Dim ii As Integer + + ii = InStr(1, txt, char) + If (ii > 0) Then + ExtraerHasta = Left(txt, ii - 1) + Else + ExtraerHasta = txt + End If + +End Function \ No newline at end of file