Generic Tools

Collection/Modules/ModCollection.bas

@@ -0,0 +1,27 @@
+Attribute VB_Name = "ModCollection"
+''''''''''''''''''''''''''''''''''''''''''''
+''            VBA Excel Tools             ''
+''            Gabriel CUGLIARI            ''
+''               Abr 2011                 ''
+''''''''''''''''''''''''''''''''''''''''''''
+
+''=== JoinRange === 
+'
+'=JoinRange(<CellRange>;<Separator>)
+'=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

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

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

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

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