Macos en Vba Excel
Macos en Vba Excel
Macos en Vba Excel
99:
'conectar Events
Application.EnableEvents = True
End Sub
'*************************************************
Msgbox strImpresoraActiva
End sub
o todavía más fácil:
Sub Devolver ImpresoraActiva()
Msgbox Application.ActivePrinter
End sub
Crear lista extensa de información sobre la máquina del usuario
Abajo te presentamos una macro para presentar varios datos del usuario/maquina.
Sub Application_Data()
'dimensiones
Dim strDataArray(10) As String
Dim i, x As Integer
End Sub
Sub SuprimirDatosEnceldas()
End Sub
Botones
Si quieres puedes añadir cualquier de estos cuatro botones (si no pones nada Excel te
pondrá vbOkOnly por defecto).
vbOkOnly
vbOkCancel
vbYesNoCancel
vbAbortRetryIgnore
Iconos
Puedes elegir entre los siguientes.
vbCritical
vbQuestion
vbExclamation
vbInformation
Título
Cualquier texto.
Devolver información
Si quieres que el programa utilice la respuesta del usuario, estas son las cifras que te
devuelve.
Ok = 1
Cancel = 2
Abort = 3
Retry = 4
Ignore = 5
Yes = 6
No = 7
Ejemplos
Te ponemos unos ejemplos módelo para que te vayas acostumbrando a las diferentes
messagebox.
Sub MessageBox()
msgbox "Actualización terminada:", _
vbOKOnly, "Información"
End Sub
Sub MessageBox()
msgbox "¿Quieres seguir?", vbYesNo, "Información importante"
End Sub
Sub MessageBox()
Dim intRespuesta As Integer
intRespuesta = MsgBox("¿Quieres seguir?", vbQuestion + vbYesNo, _
Información importante")
If intRespuesta = 6 Then
MsgBox"Seguimos"
Else
MsgBox"Terminamos"
End If
End Sub
Sub MessageBox()
msgbox "Actualización terminada:" & _
vbCrLf & vbCrLf & _
"- Importación de datos de venta." & vbCrLf & _
"- Cálculos de impuestos." & vbCrLf & _
"- Venta por proveedor." & vbCrLf _
, vbOKOnly, "Actualización terminada."
End Sub
Sub MessageBox()
msgbox "Actualización terminada:" & vbCrLf & vbCrLf & _
"- Importación de datos de venta." & vbCrLf & _
"- Cálculos de impuestos." & vbCrLf & _
"- Venta por proveedor." & vbCrLf _
, vbExclamation + vbOKOnly, _
"Actualización terminada."
End Sub
Este código sirve para abrir otro libro Excel a través del diálogo ‘Abrir’. Allí el usuario
elige el libro a abrir. Si el usuario pulsa Cancelar, el diálogo se cierra.
Este procedimiento en sí no sirve para mucho (porque luego se debe hacer algo con este
libro, verdad), pero al final será un procedimiento básico en muchos de tus futuros
programas de Excel VBA.
Sub Abrir_archivo()
'elegir archivo
strRutaArchivo = _
Application.GetOpenFilename("Libro de Microsoft Excel (*.xls), *.xls")
'abrir archivo
On Error GoTo 9
Workbooks.Open Filename:=strRutaArchivo
9:
End Sub
• Inicio
• Sitemap
• Inicio
• VBA-Macros
• VBA-Ejemplos
• Atajos
• General
• Formatos
• Fórmulas
• SQL
•
Inicio » VBA-Ejemplos » Explorador de informes
Explorador de informes
0diggsdigg
0
Share
I
Sub Auto_Open()
Sheets("Hoja2").Visible = False
Sheets("Hoja3").Visible = False
Sheets("Hoja4").Visible = False
End Sub
Sub AbrirH1()
Sheets("Hoja2").Visible = True
Sheets("Hoja2").Activate
Sheets("Hoja2").Range("A1").Select
End Sub
Sub Volver()
Sheets("Panel").Activate
Sheets("panel").Range("a1").Select
End Sub
Sub AbrirH2()
Sheets("Hoja3").Visible = True
Sheets("Hoja3").Activate
Sheets("Hoja3").Range("A1").Select
End Sub
Sub AbrirH3()
Sheets("Hoja3").Visible = True
Sheets("Hoja3").Activate
Sheets("Hoja3").Range("A1").Select
End Sub
Sub Botón6_AlHacerClic()
'Cierra el libro activo, antes guarda todos los cambios...
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Option Explicit
Sub BarraDeProgreso()
Dim R As Integer
Dim MT As Double
For R = 1 To 180
MT = Timer
Do
Loop While Timer - MT < 0.05
Application.StatusBar = "Progress: " & R & " de 180: " & _
Format(R / 180, "Percent") & " --- " & "Cumplimiento"
DoEvents
Next R
Application.StatusBar = False
End Sub
Resumen
Se usa el evento change para simular una casilla de verificación, en la columna A, y luego
combinamos con una suma condicional, que que solamente SUMA los meses que se
encuentran tildados.
Un ejemplo real
Al hacer clic sobre la columna A, tilda la celda.
Luego se puede aplicar una fórmula matricial y condicional para sumar los meses tildados.
{=SUMA(SI($A$2:$A$13<>“”;$C$2:$C$13;0))}
El código
El código debe escribirse en la misma hoja Excel, ver imagen.
'Jose Skraviuk
'ayudaexcel {at} yahoo.com.ar
If Not Application.Intersect _
(Target, Columns("A")) Is Nothing Then
If Target.Column = 4 Then
aOffset = 3
Else
aOffset = 2
End If
If IsEmpty(Target.Value) Then
With Target
.Font.Name = "Wingdings"
.Value = Chr(252)
End With
Target.Offset(0, iOffset).Select
Else
Target.Value = ""
Target.Offset(0, iOffset).Select
End If
End If
err_handler:
Application.EnableEvents = True
End Sub
Comentarios
Para evitar confusiones (sobre todo si estamos preparando una plantilla para otras
personas), podríamos optar por la fórmula SUMAPRODUCTO, que además permite
aplicar varias condiciones de una manera fácil.
=SUMAPRODUCTO((A2:A13<>“”)*C2:C13)
El código
'Jose Skraviuk
'[email protected]
End Sub
Iniciar temporizador
La primera macro inicia el temporizador.
Sub StartTemporizador()
datHora = Now + TimeSerial(0, 0, conIntervalo)
'iniciar el temporizador
Application.OnTime _
Earliesttime:=datHora, _
Procedure:=conRunMacro, _
Schedule:=True
End Sub
Tu procedimiento
Aquí pones lo que quieres que Excel haga periodicamente.
Sub Tu_Sub()
MsgBox datHora 'o cualquier instrucción
'reiniciar el temporizador
StartTemporizador
End Sub
Cerrar temporizador
El temporizador hay que cerrarlo ‘manualmente’.
Sub StopTemporizador()
On Error Resume Next
'desactivar el temporizador
Application.OnTime _
Earliesttime:=datHora, _
Procedure:=conRunMacro, _
Schedule:=False
End Sub
Todo el código
Ahora, el módulo de las macros descritas arriba debe tener el siguiente aspecto.
Public datHora As Date
Public Const conIntervalo = 60 'un minuto
Public Const conRunMacro = "Tu_Sub" 'tu proced.
Sub StartTemporizador()
datHora = Now + TimeSerial(0, 0, conIntervalo)
'iniciar el temporizador
Application.OnTime _
Earliesttime:=datHora, _
Procedure:=conRunMacro, _
Schedule:=True
End Sub
Sub Tu_Sub()
MsgBox datHora 'o cualquier instrucción
'reiniciar el temporizador
StartTemporizador
End Sub
Sub StopTemporizador()
On Error Resume Next
'desactivar el temporizador
Application.OnTime _
Earliesttime:=datHora, _
Procedure:=conRunMacro, _
Schedule:=False
End SuB
vbaModulo.Export strRuta
Crear el módulo
Entra a Herramientas – Macros – Editor VBA. A la izquierda ves (si no lo ves CTRL+R)
algo como “ProyectoVBA (Tu libro). Marca ese proyecto. Insertar – Módulo.
Doble click en el módulo nuevo, y a la derecha sale un espacio blanco, es para el código.
Herramientas – Referencias. Marca Microsoft ActiveX DataObjects x.x Library.
Ahora cierras el editor VBA, vuelves a Excel. Guardamos el libro.
El código
Sub DC_check()
Dim Bank As String
Dim Office As String
Dim DC As String
Dim Account As String
Dim BankOffice As String
Dim Valor1, Valor2, Valor3, Valor4, Valor5
DIm Valor6, Valor7, Valor8, Valor9, Valor10
Dim TestValue1 As Integer
Dim TestValue2 As Integer
Dim TestValueDC As Integer
'---------------------------------------------------
'recoger el número de cuenta
Bank = Range("B3").Text
Office = Range("C3").Text
DC = Range("D3").Text
Account = Range("E3").Text
BankOffice = Bank & Office
'---------------------------------------------------
'evaluar DC (1)
Valor1 = (Mid(BankOffice, 1, 1) * 4)
Valor2 = (Mid(BankOffice, 2, 1) * 8)
Valor3 = (Mid(BankOffice, 3, 1) * 5)
Valor4 = (Mid(BankOffice, 4, 1) * 10)
Valor5 = (Mid(BankOffice, 5, 1) * 9)
Valor6 = (Mid(BankOffice, 6, 1) * 7)
Valor7 = (Mid(BankOffice, 7, 1) * 3)
Valor8 = (Mid(BankOffice, 8, 1) * 6)
'evaluar DC completo
If TestValueDC = DC Then
Test = True
MsgBox "Correcto."
Else
Test = False
MsgBox "DC no corresponde a esta cuenta." & vbCrLf & _
"[en este caso DC sería " & TestValueDC & ".]", vbOKOnly, vbInformation
End If
End Sub
'dimensiones
Dim lngUltimaFila As Long
Dim strObjetoBuscar As String
Dim lngResultado As Long
Dim lngColumna As Long, lngFila As Long
Dim lngPegarColumna As Long, lngPegarFila As Long
Dim x As Integer, n As Integer
'objeto a buscar
strObjetoBuscar = Range("G2").Text
If strObjetoBuscar = "" Then GoTo 99
'minúsculas
strObjetoBuscar = LCase(strObjetoBuscar)
'evaluación
lngResultado = InStr(1, Cells(n, 3),strObjetoBuscar, vbTextCompare)
'copiar/pegar
If lngResultado > 0 Then
Range(Cells(n, 2), Cells(n, 4)).Copy
Range( _
Cells(lngPegarFila, lngPegarColumna), _
Cells(lngPegarFila, lngPegarColumna + 2)) _
.Select
ActiveSheet.Paste
lngPegarFila = lngPegarFila + 1
End If
Next n
'aparcar
Application.CutCopyMode = False
Range("G2").Select
99:
End Sub
Nuestro ejemplo
En este ejemplo el rango que nos interesa sumar son los valores correspondientes a “BB”,
es decir C8:C13.
Escribir la suma (en celda)
'el rango a sumar
varSuma = Range(Cells(8, 3), Cells(13, 3))
'sumar el rango
Cells(1, 1) = Application.WorksheetFunction.Sum(varSuma)
Sub Ajustar_izq_der()
If Selection.HorizontalAlignment = xlRight Then
Selection.HorizontalAlignment = xlLeft
Else
Selection.HorizontalAlignment = xlRight
End If
End Sub
Pegar formato
Sub PegarFormato()
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
End Sub
Pegar valor
Sub PegarValor()
Selection.PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
End Sub
Dos decimales
Sub DosDec()
Dim Area As Range
Set Area = Selection
For Each Cell In Area
z = Round(Cell, 2)
Cell.Value = z
Cell.NumberFormat = "#,##0.00"
Next Cell
End Sub
Separador de miles
Sub SeparadorMil()
Dim Area As Range
Set Area = SelectionIf Area.NumberFormat = "#,##0" Then
Area.NumberFormat = "#,##0.00"
Else
Selection.NumberFormat = "#,##0"
End If
End Sub
Autofilter
Sub FilterExcel()
Selection.AutoFilter
End Sub
Sub MostrarHojas()
Set wsHoja = Worksheets
For Each wsHoja In ActiveWorkbook.Worksheets
If wsHoja.Visible = False Then
wsHoja.Visible = True
End If
Next wsHoja
End Sub
Nuestro ejemplo
En este ejemplo el rango que nos interesa sumar son los valores correspondientes a “BB”,
es decir C8:C13.
Escribir la suma (en celda)
'el rango a sumar
varSuma = Range(Cells(8, 3), Cells(13, 3))
'sumar el rango
Cells(1, 1) = Application.WorksheetFunction.Sum(varSuma)
Declarar variables
0diggsdigg
0
Share
¿Porqué declarar variables?
El código saldrá más estructurado
Si no declaras un variable, no sabrás que tipo de datos contendrá.
Es más seguro – evitarás errores tipográficos
VBA te ayudará a poner los nombres correctos. Si no, un error tipográfico puede parar el
programa.
El código trabajará más eficaz
Variables no declaradas serán tratatos como Variants, las cuales ocupan mucha más
memoria.
Te ayudará a programar
VBA te ayuda a elegir propiedades/métodos que corresponden a esa variable.
Declarar variables
Una variable se declara empleando el comando DIM. DIM significa Dimension, y viene del
antiguo BASIC. Al declarar, puedes indicar el número de dimensiones que la variable va a
tener (ej. guardar números dentro de una variable, en 3 dimensiones).
Para que sea más fácil leer el código, pon un indicador en el nombre de la variable. Así
basta con leer el nombre de la variable para saber de que tipo es. Puede ser str para String,
int para Integer etc.
Una alternativa al DIM es Public. La variable será accesible desde todas partes de tú
proyecto VBA.
Poner nombres explicativos
Intenta poner nombres explicativos a las variables.
Dim strCodigoPostal as String
Dim datFechaRecogida as Date
El nombre puede tener hasta 254 carácteres (por supuesto demasiado…). No puede
empezar con una cifra. Algunos nombres son reservados para VBA/Excel, la cual te
notificará al ejecutar.
¿Donde poner las declaraciones?
VBA te deja declarar casi en cualquier sitio del código. No obstante, la posición puede dar
resultados distintos. Por eso es recomendable seguir unas normas.
Tipo de declaración Ubicación Accesible
Encima del procedimiento (antes Todos los procedimientos del
Dim
del primer Sub) módulo.
Antes de un procedimiento
Dim Ese procedimiento .
específico.
Dim Dentro de un procedimiento. Resto de ese procedimiento.
Encima del procedimiento (antes Todos los procedimientos (de
Public
del primer Sub) todos los módulos)
El ejemplo crea una referencia al objeto Excel para abrir un libro indicado, y luego recorre
en un bucle For Next todas las hojas que tenga el libro .
Luego dependiendo del formato elegido, va guardando el contenido de cada hoja
individualmente en el App.path del proyecto con el método SaveAs de vba .
Pasos para el ejemplo
• Añadir la referencia a Microsoft Excel Object Library
• Agregar un command1
• Un Text1 para escribir el path del Xls
Nota: si se quiere , para no incluir la referencia , se debe declarar las variables ObjExcel y
Objsheet como de tipo Object
Dim ObjExcel As Object
Dim ObjHoja As Object
1. Option Explicit
2.
3.
4. ' enumeración para espcificar el formato de salida de los datos
5. Private Enum EFormato
6. CSV = 6
7. HTML = 44
8. TEXTO = 20
9. EXCEL = -4143
10.End Enum
11.
12.' botón para exportar las hojas
13.''''''''''''''''''''''''''''''''
14.Private Sub Command1_Click()
15. Call Exportar_Hojas("c:\Nuevo Microsoft Excel Worksheet.xls", TEXTO)
16.End Sub
17.
18.' Sub que exporta
19.''''''''''''''''''''
20.Private Sub Exportar_Hojas(PathLibro As String, _
21. Formato As EFormato)
22.
23.Dim ObjExcel As EXCEL.Application
24.Dim ObjHoja As EXCEL.Worksheet
25.Dim Extension As String
26.Dim opcion As Variant
27.Dim i As Integer
28.
29. ' verifca que el path del xls sea válido
30. If Len(Dir(PathLibro)) = 0 Then
31. MsgBox "El archivo xls que especificó no existe. Verifique la ruta", v
bCritical
32. Exit Sub
33. End If
34. ' Diálogo de pregunta para elegir el tipo de archivo
35. opcion = InputBox("Seleccionar un formato para guardar cada hoja de
l libro " & _
36. "seleccionado en archivos individuales: " & _
37. vbNewLine & String(25, "-") & vbNewLine & _
38. "1 - Archivo de Excel" & vbNewLine & _
39. "2 - Archivo Csv" & vbNewLine & _
40. "3 - Archivo Html" & vbNewLine & _
41. "4 - Archivo de texto plano txt" & _
42. vbNewLine, "Seleccionar opción para guardar")
43.
44. Select Case opcion
45. Case 1: Formato = EXCEL: Extension = ".xls"
46. Case 2: Formato = CSV: Extension = ".csv"
47. Case 3: Formato = HTML: Extension = ".Html"
48. Case 4: Formato = TEXTO: Extension = ".txt"
49. Case vbNullString:
50. MsgBox "Acción cancelada", vbInformation
51. Exit Sub
52. Case Else: MsgBox "No ha seleccionado ninguna opción", _
53. vbCritical, "Error"
54. Exit Sub
55. End Select
56.
57.
58. ' crea el Objeto Application
59. Set ObjExcel = CreateObject("Excel.Application")
60.
61. With ObjExcel
62.
63. .DisplayAlerts = False
64. ' abre
65. .Workbooks.Open (PathLibro)
66.
67. ' recorre la colección Sheets, es decir todas las hojas
68. For i = 1 To .Worksheets.Count
69.
70. ' abre
71. .Workbooks.Open (PathLibro)
72.
73. ' referencia a esta sheet
74. Set ObjHoja = .Sheets(i)
75. ' selecciona la hoja actual con el método Select
76. ObjHoja.Select
77. ' Copia la hoja entera con el método Copy
78. ObjHoja.Copy
79.
80. ' exporta la hoja individual al formato indicado con SaveAs
81. .ActiveWorkbook.SaveAs FileName:=App.Path + "-" & _
82. Trim(ObjHoja.Name) + Extension, _
83. FileFormat:=Formato, _
84. Password:="", _
85. WriteResPassword:="", _
86. ReadOnlyRecommended:=False, _
87. CreateBackup:=False
88. Next
89. End With
90. ' cierra el libro y elimina las referencias
91. ObjExcel.Quit
92. Set ObjHoja = Nothing
93. Set ObjExcel = Nothing
94. ' ok
95. MsgBox "Archivos generados en el directorio : " & App.Path, vbInforma
tion
96.
97.
98.Exit Sub
99.' rutina de error
100.'''''''''''''''''''
101.ErrorSub:
102. MsgBox Err.Description
103. On Error Resume Next
104. ObjExcel.Quit
105. Set ObjHoja = Nothing
106. Set ObjExcel = Nothing
107.End Sub
108.
109.
110.Private Sub Form_Load()
111. Command1.Caption = "Exportar ..."
112. Text1 = "Indicar aqui la ruta del libro "
113.End Sub
Rutina que recorre las celdas de una columna
determinada, para buscar y eliminar los valores
repetidos
El ejemplo tiene una rutina a la cual se le pasa como argumentos el path del libro, el
número de columna a verificar, y la fila inicial y la fila final en la que buscará los valores
duplicados
1. Option Explicit
2.
3.
4. Private Sub Chequear_Valores(sElementos() As Variant)
5. Dim TempArray() As String
6. Dim x As Integer, x2 As Integer, y As Integer
7. Dim z As Integer, Elemento As Variant
8. Dim ArrFinal() As Variant
9. Dim nRedim As Long
10.
11. Dim i As Integer
12. For i = LBound(sElementos) To UBound(sElementos)
13. ReDim Preserve TempArray(i)
14. TempArray(i) = sElementos(i)
15. Next
16. For x = 0 To UBound(sElementos)
17. z=0
18. For y = 0 To UBound(sElementos)
19. If sElementos(x) = TempArray(z) And y <> x Then
20. sElementos(y) = ""
21. nRedim = nRedim + 1
22. End If
23. z=z+1
24. Next y
25. Next x
26.
27. i=0
28. ReDim ArrFinal(0)
29.
30. For Each Elemento In sElementos
31. If Elemento <> "" Then
32. ' agrega los elementos
33. ArrFinal(i) = Elemento
34. i=i+1
35. ReDim Preserve ArrFinal(i)
36. End If
37. Next
38. ' retorna la lista
39. sElementos = ArrFinal
40.
41.End Sub
42.
43.Private Sub Eliminar_Duplicados_PorColumna(PathXLS As String, _
44. Columna As Long, _
45. DesdeFila As Long, _
46. HastaFila)
47.
48. Dim objExcel As Excel.Application
49. Dim Elementos() As Variant
50.
51. Set objExcel = New Excel.Application
52. ' abre el xls
53. objExcel.Workbooks.Open (PathXLS)
54.
55. ReDim Elementos(0)
56. Me.MousePointer = vbHourglass
57. With objExcel.ActiveWorkbook.Sheets(1)
58.
59. Dim fila As Long
60. Dim n As Long
61. n=1
62. ' recorre desde el rango de fila
63. For fila = DesdeFila To HastaFila
64. ' almacena los datos a verificar
65. Elementos(n - 1) = .Application.Cells(fila, Columna)
66. ' elimina el valor de la celda
67. .Application.Cells(fila, Columna) = ""
68. ReDim Preserve Elementos(UBound(Elementos) + 1)
69. n=n+1
70. Next
71. ' llama al rutina para verificar los valores repetidos
72. Chequear_Valores Elementos
73.
74. Dim fActual As Long
75. n=0
76. ' recorre la lista de los elementos para asignarlos a las celdas
77. For n = 0 To UBound(Elementos) - 1
78. .Application.Cells((DesdeFila + fActual), Columna).Value = Eleme
ntos(n)
79. fActual = fActual + 1
80. Next
81. End With
82. ' guarda los cambios del libro
83. objExcel.ActiveWorkbook.Save
84. objExcel.Quit
85. Set objExcel = Nothing
86. Me.MousePointer = vbNormal
87.
88.End Sub
89.
90.Private Sub Command1_Click()
91.
92. 'pasa el libro, el número de la columna _
93. a verificar, la fila inicial, y la fina final
94. Call Eliminar_Duplicados_PorColumna("c:\libro1.xls", 1, 5, 250)
95.
96.End Sub
Option Explicit
Nota. Otra forma de realizar esto, podría ser, cargar todos los valores en un array o vector.
Luego utilizar esta función para eliminar los datos duplicados, y por último, pasar el array a
la hoja del libro.
Nota: Si se pasa como parámetro en la hoja de destino, un nombre de una que ya existe , se
visualiza un error mediante un mensaje, ya que como está puesto el ejemplo, solo es para
copiar en una nueva hoja, no en una ya existente.
1. Option Explicit
2.
3.
4. ' NameHojaOrigen: La hoja que se va a copiar _
5. NameNuevaHoja : Nombre para la nueva _
6. PathLibro : Ruta del Xls
7.
8. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
9. Private Sub Copiar_hoja(NameHojaOrigen As String, _
10. NameNuevaHoja As String, _
11. PathLibro As String)
12.
13.
14.On Error GoTo Error_Sub
15.
16.' crea el objeto Excel
17.Dim ObjExcel As Object
18.Set ObjExcel = CreateObject("Excel.Application")
19.
20.
21.'ObjExcel.Visible = True
22.
23.'abre el libro
24.ObjExcel.Workbooks.Open PathLibro
25.
26.With ObjExcel
27. Dim SheetO As Object
28. Dim SheetD As Object
29.
30. On Error Resume Next
31. Set SheetO = .Sheets(NameHojaOrigen)
32. Set SheetD = .Sheets(NameNuevaHoja)
33.
34. If SheetO Is Nothing Then
35. MsgBox "Error. la hoja Origen indicada no existe", vbCritical
36. End If
37. If Not SheetD Is Nothing Then
38. MsgBox "Error. la hoja Destino ya existe en el libro. " & _
39. "Indicar otro nombre para la nueva hoja", vbCritical
40. End If
41.
42. If SheetD Is Nothing And Not SheetO Is Nothing Then
43. On Error GoTo 0
44. Set SheetO = Nothing
45. Set SheetD = Nothing
46.
47. Else
48. Set SheetO = Nothing
49. Set SheetD = Nothing
50.
51. ObjExcel.Quit
52. Set ObjExcel = Nothing
53. Exit Sub
54. End If
55.
56. .Sheets.Add ' agrega con Add una nueva hoja en el libro
57. .ActiveSheet.Select ' La selecciona
58. .ActiveSheet.Name = NameNuevaHoja ' le cambia el nombre
59. .Sheets(NameHojaOrigen).Select ' Se posiciona en la hoja de origen
60. .Cells.Select ' selecciona todas las celdas
61. .Selection.Copy ' copia el contenido
62. .Sheets(NameNuevaHoja).Select ' se posiciona en la nueva hoja
63. .Cells.Select ' selecciona
64. .ActiveSheet.Paste ' pega los datos
65. .Application.CutCopyMode = False
66. .ActiveWorkbook.Save ' graba los cambios en el libro
67.
68.End With
69.
70.' descarga la referencia y cierra el Excel
71.ObjExcel.Quit
72.Set ObjExcel = Nothing
73.
74.MsgBox "Ok", vbInformation
75.
76.Exit Sub
77.Error_Sub:
78.MsgBox Err.Description
79.On Error Resume Next
80.
81.Set ObjExcel = Nothing
82.
83.Err.Clear
84.End Sub
85.
86.Private Sub Form_Load()
87. Call Copiar_hoja("Informe", "Copia De Informe", "c:\Libro1.xls")
88.End Sub
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Copiar_hoja(NameHojaOrigen As String, _
NameNuevaHoja As String, _
Formulario
El ejemplo tiene una rutina llamada Reemplazar con los siguientes parámetros :
Texto planoImprimir
El último parámetro es un valor de tipo Boolean que indica si se tomará en cuanta las
mayúsculas y minúsculas en la búsqueda. Por defecto está en False, y no se tiene en
cuenta .
También, si se quiere que al buscar, solo busque la cadena completa en la celda, hay que
modificar el valor LookAt, del método Replace. Si el mismo tiene el valor 1, buscará la
cadena completa en las celdas, si tiene el valor 2, buscará la cadena parcial.
Nota: Por defecto en el ejemplo, el valor de LookAt está en 1, por lo tanto reemplazará solo
los datos completos en las celdas
Controles
• Text1 para indicar la ruta del libro de Excel
• Text2 para indicar el Sheet
• Text3 para el dato que se va a buscar
• Text4 para el texto de reemplazo
• Un CommandButton
1. Option Explicit
2.
3. ' botón que ejecuta la rutina para buscar y reemplzar en la hoja
4. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
5. Private Sub Command1_Click()
6. Reemplazar Text1, Text2, Text3, Text4, False
7. End Sub
8.
9.
10.' Rutina que busca en la hoja y reemplaza todo
11.'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
12.Sub Reemplazar(PathXls As String, _
13. Hoja As String, _
14. TextoFind As String, _
15. TextoReplace As String, _
16. Optional Match_Case As Boolean)
17.
18.On Error GoTo Error_Sub
19.
20.Dim AppXls As Object
21.
22.Dim ret As Boolean
23.
24. ' verifica si existe el path del archivo xls
25. If Len(Dir(PathXls)) = 0 Then
26. MsgBox "No se ha encontrado la ruta el Libro", vbCritical
27. Exit Sub
28. End If
29.
30. If Hoja = vbNullString Or _
31. TextoFind = vbNullString Or _
32. TextoReplace = vbNullString Then
33. MsgBox "No se indicaron algunos parámetros", vbCritical
34. Exit Sub
35. End If
36.
37. Me.MousePointer = vbHourglass
38.
39. ' Nuevo objeto de Excel Application
40. Set AppXls = CreateObject("Excel.Application")
41.
42. ' abre el libro
43. AppXls.Workbooks.Open PathXls
44.
45. ' opcional ( excel no visible )
46. AppXls.Visible = False
47.
48. ' Ejecuta el método Replace, indicando el Sheet, y las _
49. opciones de búsqueda y reemplazo
50. ret = AppXls.ActiveWorkbook.Sheets(Hoja).Application.Cells.Replace(
What:=TextoFind, _
51. Replacement:=TextoReplace, _
52. LookAt:=1, _
53. SearchOrder:=1, _
54. MatchCase:=Match_Case)
55.
56. AppXls.ActiveWorkbook.Save
57.
58. ' cierra y elimina la referencia de Excel
59. AppXls.quit
60. Set AppXls = Nothing
61.
62. Me.MousePointer = 0
63. MsgBox "Listo", vbInformation
64.
65.
66.Exit Sub
67.
68.' rutina de error
69.Error_Sub:
70.MsgBox Err.Description
71.On Error Resume Next
72. AppXls.quit
73. Set AppXls = Nothing
74. Me.MousePointer = 0
75.End Sub
76.
77.
78.Private Sub Form_Load()
79. Command1.Caption = "Reemplazar todo"
80. Me.Caption = "Buscar y reemplzar en Excel"
81. Text1.Text = "c:\libro1.xls"
82. Text2 = "Hoja1"
83. Text3.Text = "texto a buscar"
84. Text4.Text = "Texto a reemplzar"
85.End Sub
Option Explicit