Programación

Vamos a analizar distintos códigos de VBA para Office y poder sacarles el máximo rendimineto.

Mayusculas Minusculas Excel

Mayúsculas - Minúsculas - Frase - Oración

Válido para todas las versiones de Excel desde la versión 97 -2007

May-minus-Oracion-Frase - Word - Excel

Por Héctor Miguel Orozco Díaz

Cuántas veces hemos necesitado el tener en Excel una opción como la tiene Word, para poder cambiar una o varias celdas de mayúscula a minúscula o bien a tipo frase o tipo oración.....

Con los siguientes procedimientos podemos tener rápidamente convertida nuestra celda o bien nuestra hoja completa dependiendo de nuestra necesidad

1 Mediante un InputBox [ que podemos escribir en él, bien con la inicial o bien escribiendo Frase, título,minúsculas o Mayúsculas ]

Si utilizáis el archivo de muestra que se expone al final de este articulo para el Primer procedimiento:

dialogBoxLauncher Cinta Ribbon

InputBox mayus-minus-Frase-OracionExcel

Procedimiento Utilizado

Sub Capitaliza(Opcion As Byte): On Error Resume Next
  If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
  Dim ModoCalc, Eventos As Boolean, VolverA As Object, Confirma As Integer, Cambio, _
         AplicarEn As Range, Frase As Boolean, Celda As Range
  With Application: .ScreenUpdating = False: Eventos = .EnableEvents
    ModoCalc = .Calculation: .Calculation = xlCalculationManual
    If TypeName(Selection) <> "Range" Then Set VolverA = Selection: ActiveCell.Activate
    If Selection.Count = 1 Then
      Confirma = MsgBox("La seleccion actual es de ""solamente"" una celda..." & vbCr & _
                        "Deseas aplicar el cambio en todas las celdas de la hoja ?", _
                        vbYesNoCancel + vbDefaultButton2, "Confirmacion requerida !!!")
      If Confirma = vbCancel Then GoTo EndSub
      Set AplicarEn = IIf(Confirma = vbNo, ActiveCell, _
        ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
    Else: Set AplicarEn = Selection.SpecialCells(xlCellTypeConstants, xlTextValues)
    End If: Select Case Opcion: Case 0: GoTo SelectCase
      Case 1: Cambio = vbUpperCase: Case 2: Cambio = vbLowerCase
      Case 3: Cambio = vbProperCase: Case 4: Frase = True: End Select: GoTo Execute
SelectCase:
    Select Case UCase(Left(Trim(InputBox("Elige el tipo de ""salida""" & vbCr & _
        "[T] = Titulo" & vbTab & "[ I ] = minusculas" & vbCr & _
        "[F] = Frase" & vbTab & "[A] = MAYUSCULAS", "Alternar (May/min)usculas...")), 1))
      Case "A": Cambio = vbUpperCase: Case "I": Cambio = vbLowerCase
      Case "T": Cambio = vbProperCase: Case "F": Frase = True: Case Else: GoTo EndSub
    End Select
Execute:
    For Each Celda In AplicarEn: If Frase _
        Then Celda = UCase(Left(Celda, 1)) & LCase(Mid(Celda, 2)) _
        Else Celda = StrConv(Celda, Cambio)
    Next
EndSub:
    .Calculation = ModoCalc: .EnableEvents = Eventos: End With: Set AplicarEn = Nothing
  If Not VolverA Is Nothing Then VolverA.Select: Set VolverA = Nothing
End Sub

Si No utilizáis el archivo de muestra que se expone al final del articulo y lo vais a utilizar (el anterior procedimiento) en un módulo estándar de Excel, entonces...→

El procedimiento (Capitaliza) requiere de un argumento (Opción) que debiera ser pasado desde otra macro que la llame o sea, si queréis ejecutar directamente alguna de las "opciones" (1=mayúsculas, 2=minúsculas, 3=nombre propio, 4=frase), deberás incluir dicha opción (numero) al llamar a la macro (Capitaliza).

Si quieres que se ejecute el inputbox para seleccionar "al vuelo"

Sub demo()
Call Capitaliza(0)
End Sub

Otra alternativa es modificar el anterior procedimiento (Capitaliza) estableciendo como "opcional" el argumento (Opción) y pre-fijarlo en 0 para que muestre el inputbox

Sub Capitaliza(Optional Opcion As Byte = 0 ): On Error Resume Next

Y simplemente llamarla desde otro procedimiento

Sub demo():Call Capitaliza:End Sub

2 Convertir como en Office Word añadiéndole al siguiente procedimiento un atajo de teclado [Alt + F3] y así poder alternar entre [may-min]uscula, frase, título u oración combinando dicho atajo de teclado tal y como muestra el artículo que se os ofrece al final ...

Sub CapitalizaComoWord(): On Error Resume Next
  If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
  Dim ModoCalc, Eventos As Boolean, VolverA As Object, Confirma As Integer, Cambio, _
         AplicarEn As Range, Frase As Boolean, Celda As Range
  With Application: .ScreenUpdating = False: Eventos = .EnableEvents
    ModoCalc = .Calculation: .Calculation = xlCalculationManual
    If TypeName(Selection) <> "Range" Then Set VolverA = Selection: ActiveCell.Activate
    If Selection.Count = 1 Then
      Confirma = MsgBox("La seleccion actual es de ""solamente"" una celda..." & vbCr & _
                        "Deseas aplicar el cambio en todas las celdas de la hoja ?", _
                        vbYesNoCancel + vbDefaultButton2, "Confirmacion requerida !!!")
      If Confirma = vbCancel Then GoTo EndSub2
      Set AplicarEn = IIf(Confirma = vbNo, ActiveCell, _
        ActiveSheet.Cells.SpecialCells(xlCellTypeConstants, xlTextValues))
    Else: Set AplicarEn = Selection.SpecialCells(xlCellTypeConstants, xlTextValues)
    End If
    If ActiveCell = StrConv(ActiveCell, vbProperCase) Then GoTo SkipCase2 Else Cambio = vbUpperCase
    If ActiveCell = UCase(ActiveCell) Then Cambio = vbLowerCase
    If ActiveCell = LCase(ActiveCell) Then Cambio = vbProperCase
    For Each Celda In AplicarEn: Celda = StrConv(Celda, Cambio): Next: GoTo EndSub2
SkipCase2:
    For Each Celda In AplicarEn: Celda = UCase(Left(Celda, 1)) & LCase(Mid(Celda, 2)): Next
EndSub2:
    .Calculation = ModoCalc: .EnableEvents = Eventos: End With: Set AplicarEn = Nothing
  If Not VolverA Is Nothing Then VolverA.Select: Set VolverA = Nothing
End Sub

 

Imprimir