Twittear

(macros) Sub euros a dolares y libras

Esta es una macro para Word que se ejecuta poniendo el cursor en cualquier celda de cualquier tabla. Busca una columna cuya primera celda sea EUROS. Si la encuentra inserta dos columnas a la derecha de la culumna EUROS con los valores en DOLARES y LIBRAS presuponiendo valores 1.3216 y 0.85 en el código y que puede ajustarse a medida. La columna EUROS puede ser cualquiera de las columnas de la tabla. Si no existe columna EUROS, no hará nada. Si no selecciona la tabla da mensaje de error. Si la tabla ya ha insertado dos columnas con dolares y libras no debe duplicar columnas. Para solucionar esto último, cambiamos el no EUROS por ENEUROS con lo cual la macro, aunque se ejecute de nuevo por error no insertará nuevas columnas.
La instrucción Selection.Information(wdWithInTable) devuelve FALSE si el cursor Selection no se encuentra en una tabla, en cuyo caso lanzamos un mensaje de advertencia con la instrucción
MsgBox ("situe el cusor sobre una tabla"). Leemos los valores de las celdas dela primera fila en busca del texto EUROS con una instruccin For y el metodo Selection.Rows(1).Cells.Count de iteraciones y guardamos en objeto cadena de tipo Range que permite métodos y propiedades como en esta instrucción Find.Execute para encontrar un texto:
cadena.Find.Execute FindText:="EUROS", MatchWholeWord:=True, _
Forward:=True
encuentra el valor de si existe columna EUROS...

Sub euros()
 Dim caja, endol, enlib As Double
 Dim I, X As Integer
 Dim cadena As Range
 If Selection.Information(wdWithInTable) = True Then
  For I = 1 To Selection.Rows(1).Cells.Count
   Set cadena = Selection.Tables(1).Cell(1, I).Range
   cadena.Find.Execute FindText:="EUROS", MatchWholeWord:=True, Forward:=True
   If cadena.Find.Found = True Then
    Selection.Tables(1).Range.Columns(I).Cells.Split NumColumns:=3
    Selection.Tables(1).Cell(1, I).Range.Text = "ENEUROS"
    Selection.Tables(1).Cell(1, I + 1).Range.Text = "DOLARES"
    Selection.Tables(1).Cell(1, I + 2).Range.Text = "LIBRAS"
    For X = 2 To Selection.Columns(1).Cells.Count
     Set cadena = Selection.Tables(1).Cell(X, I).Range
     caja = Val(cadena.Text)
     endol = caja * 1.3216
     enlib = caja * 0.85
     Selection.Tables(1).Cell(X, I + 1).Range.Text = endol
     Selection.Tables(1).Cell(X, I + 2).Range.Text = enlib
    Next X
   End If
  Next I
 Else
  MsgBox ("situe el cusor sobre una tabla")
 End If
End Sub