Saludos Estimados miembros del foro, actualmente tengo una macro que por años me a funcionado muy bien, recientemente incorporé otra macro en otra hoja y aunque no tiene relación la primera ejecuta también la nueva macro
pido ayuda ya que no entiendo mucho esto de las macros ya que he ido armando algunas con ayuda de los foros
Explico la temática
MACRO HOJA 1
celda C4 en esta celda generalmente va un numero que al dar ENTER realiza varias acciones como:
crear un archivo con este numero, previa verificación de que no exista este numero en tres carpetas diferente
Pone fecha y hora en determinadas celdas
y por ultimo copia el valor de varias celdas en dos archivos de texto idénticos en dos lugares diferentes
ACONTINUACION MI MACRO
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "C4" Then 'en esta celda generalmente va un numero
r1 = "C:\Users\Documents\2021\"
r2 = "C:\Users\Documents\2021\NUEVO\"
r3 = "C:\Users\\Documents\2021\NUEVO1\"
Dim NombreFichero As String
[C8] = Date
[D8] = Time
NombreFichero = Range("I7").Value 'I7 corresponde a la celda con el nombre de fichero, _
que es el numero de C4 o mas un texto otra celda
ChDir r1
Archivo = Dir(NombreFichero & ".xls")
If Archivo = "" Then
ChDir r2
Archivo = Dir(NombreFichero & ".xls")
If Archivo = "" Then
ActiveWorkbook.SaveAs Filename:=NombreFichero
Else
MsgBox "Ya existe el archivo en la ruta " & r2 & " VERIFIQUE Y EDITE EL ARCHIVO CREADO"
'msg = MsgBox("El archivo en la ruta: " & r2 & " ya existe, ¿Deseas reemplazarlo?", vbQuestion + vbYesNo, "")
'If msg = vbYes Then
'ChDir r3
'ActiveWorkbook.SaveAs Filename:=NombreFichero
End If
Dim Archivotxt As String
Set fs = CreateObject("Scripting.FileSystemObject")
Archivotxt = "C:\Users\Documents\2021\Varios Excel\dato1.txt" '<---Ruta y nombre del Txt a crear
If Len(Dir(Archivotxt)) = 0 Then
Set a = fs.CreateTextFile(Archivotxt, True)
a.Close
End If
Set a = fs.OpenTextFile(Archivotxt, 8)
texto = Range("C4").Value & " ; " & Range("C3").Value & " ; " & Format(Range("C8").Value, "dd/mm/yyyy") & " ; " & Format(Range("D8").Value, "h:mm:ss AM/PM")
a.WriteLine (texto) '<-----celda que se escribe en el Txt, se escribe en un renglon del txt
a.Close
Set fs = Nothing
Set Archivo = Nothing
Set fs = CreateObject("Scripting.FileSystemObject")
Archivotxt = "C:\Users\Application Data\Microsoft\Forms\dato1.txt" '<---Ruta2 y nombre del Txt a crear
If Len(Dir(Archivotxt)) = 0 Then
Set a = fs.CreateTextFile(Archivotxt, True)
a.Close
End If
Set a = fs.OpenTextFile(Archivotxt, 8)
texto = Range("C4").Value & " ; " & Range("C3").Value & " ; " & Format(Range("C8").Value, "dd/mm/yyyy") & " ; " & Format(Range("D8").Value, "h:mm:ss AM/PM")
a.WriteLine (texto) '<-----celda que se escribe en el Txt, se escribe en un renglon del txt
a.Close
Set fs = Nothing
Set Archivo = Nothing
Else
MsgBox "Ya existe el archivo en la ruta " & r1 & " VERIFIQUE Y EDITE EL ARCHIVO CREADO"
End If
End If
End Sub
MACRO 2 HOJA 2
En esta macro hay dos botones que al activar crea un código QR en la hoja y luego imprime la hoja
los dos botones generan lo mismo con la diferencia que el uno coloca la palabra positivo y el otro la palabra negativo en la mima celda
es decir crear un archivo PDF en un lugar determinado del disco y luego imprime este PDF
Sub Botón1251_AlHacerClic()
'
' Botón1249_AlHacerClic Macro
' Macro grabada el 21/11/2012 por edgar
'
Application.ScreenUpdating = False
'Sub CreaPDF()
Worksheets("covid Ag").Activate
Range("A38").Select
ActiveCell.FormulaR1C1 = "=HYPERLINK(CONCATENATE(R[1]C,R[2]C,R[3]C))"
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
[F17] = Date
[J17] = Time
Range("M35").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("A35").Select
ActiveCell.FormulaR1C1 = "hoja1-"
Range("m35").Select
ActiveCell.FormulaR1C1 = "POSITIVO"
nombre = Cells(40, 1).Value
Ruta = Cells(42, 1).Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & nombre, _
Quality:=xlQualityStandard, IncludedocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1
End Sub
Sub Botón1252_AlHacerClic()
'
' Botón1249_AlHacerClic Macro
' Macro grabada el 21/11/2012 por edgar
'
Application.ScreenUpdating = False
'Sub CreaPDF()
Worksheets("covid Ag").Activate
Range("A38").Select
ActiveCell.FormulaR1C1 = "=HYPERLINK(CONCATENATE(R[1]C,R[2]C,R[3]C))"
Range("A38").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
[F17] = Date
[J17] = Time
Range("A35").Select
ActiveCell.FormulaR1C1 = "hoja1-"
Range("m35").Select
ActiveCell.FormulaR1C1 = "NEGATIVO"
nombre = Cells(40, 1).Value
Ruta = Cells(42, 1).Value
Saludos Estimados miembros del foro, actualmente tengo una macro que por años me a funcionado muy bien, recientemente incorporé otra macro en otra hoja y aunque no tiene relación la primera ejecuta también la nueva macro
pido ayuda ya que no entiendo mucho esto de las macros ya que he ido armando algunas con ayuda de los foros
Explico la temática
MACRO HOJA 1
celda C4 en esta celda generalmente va un numero que al dar ENTER realiza varias acciones como:
crear un archivo con este numero, previa verificación de que no exista este numero en tres carpetas diferente
Pone fecha y hora en determinadas celdas
y por ultimo copia el valor de varias celdas en dos archivos de texto idénticos en dos lugares diferentes
ACONTINUACION MI MACRO
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "C4" Then 'en esta celda generalmente va un numero
r1 = "C:\Users\Documents\2021\"
r2 = "C:\Users\Documents\2021\NUEVO\"
r3 = "C:\Users\\Documents\2021\NUEVO1\"
Dim NombreFichero As String
[C8] = Date
[D8] = Time
NombreFichero = Range("I7").Value 'I7 corresponde a la celda con el nombre de fichero, _
que es el numero de C4 o mas un texto otra celda
ChDir r1
Archivo = Dir(NombreFichero & ".xls")
If Archivo = "" Then
ChDir r2
Archivo = Dir(NombreFichero & ".xls")
If Archivo = "" Then
ActiveWorkbook.SaveAs Filename:=NombreFichero
Else
MsgBox "Ya existe el archivo en la ruta " & r2 & " VERIFIQUE Y EDITE EL ARCHIVO CREADO"
'msg = MsgBox("El archivo en la ruta: " & r2 & " ya existe, ¿Deseas reemplazarlo?", vbQuestion + vbYesNo, "")
'If msg = vbYes Then
'ChDir r3
'ActiveWorkbook.SaveAs Filename:=NombreFichero
End If
Dim Archivotxt As String
Set fs = CreateObject("Scripting.FileSystemObject")
Archivotxt = "C:\Users\Documents\2021\Varios Excel\dato1.txt" '<---Ruta y nombre del Txt a crear
If Len(Dir(Archivotxt)) = 0 Then
Set a = fs.CreateTextFile(Archivotxt, True)
a.Close
End If
Set a = fs.OpenTextFile(Archivotxt, 8)
texto = Range("C4").Value & " ; " & Range("C3").Value & " ; " & Format(Range("C8").Value, "dd/mm/yyyy") & " ; " & Format(Range("D8").Value, "h:mm:ss AM/PM")
a.WriteLine (texto) '<-----celda que se escribe en el Txt, se escribe en un renglon del txt
a.Close
Set fs = Nothing
Set Archivo = Nothing
Set fs = CreateObject("Scripting.FileSystemObject")
Archivotxt = "C:\Users\Application Data\Microsoft\Forms\dato1.txt" '<---Ruta2 y nombre del Txt a crear
If Len(Dir(Archivotxt)) = 0 Then
Set a = fs.CreateTextFile(Archivotxt, True)
a.Close
End If
Set a = fs.OpenTextFile(Archivotxt, 8)
texto = Range("C4").Value & " ; " & Range("C3").Value & " ; " & Format(Range("C8").Value, "dd/mm/yyyy") & " ; " & Format(Range("D8").Value, "h:mm:ss AM/PM")
a.WriteLine (texto) '<-----celda que se escribe en el Txt, se escribe en un renglon del txt
a.Close
Set fs = Nothing
Set Archivo = Nothing
Else
MsgBox "Ya existe el archivo en la ruta " & r1 & " VERIFIQUE Y EDITE EL ARCHIVO CREADO"
End If
End If
End Sub
MACRO 2 HOJA 2
En esta macro hay dos botones que al activar crea un código QR en la hoja y luego imprime la hoja
los dos botones generan lo mismo con la diferencia que el uno coloca la palabra positivo y el otro la palabra negativo en la mima celda
es decir crear un archivo PDF en un lugar determinado del disco y luego imprime este PDF
Sub Botón1251_AlHacerClic()
'
' Botón1249_AlHacerClic Macro
' Macro grabada el 21/11/2012 por edgar
'
Application.ScreenUpdating = False
'Sub CreaPDF()
Worksheets("covid Ag").Activate
Range("A38").Select
ActiveCell.FormulaR1C1 = "=HYPERLINK(CONCATENATE(R[1]C,R[2]C,R[3]C))"
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
[F17] = Date
[J17] = Time
Range("M35").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Range("A35").Select
ActiveCell.FormulaR1C1 = "hoja1-"
Range("m35").Select
ActiveCell.FormulaR1C1 = "POSITIVO"
nombre = Cells(40, 1).Value
Ruta = Cells(42, 1).Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & nombre, _
Quality:=xlQualityStandard, IncludedocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1
End Sub
Sub Botón1252_AlHacerClic()
'
' Botón1249_AlHacerClic Macro
' Macro grabada el 21/11/2012 por edgar
'
Application.ScreenUpdating = False
'Sub CreaPDF()
Worksheets("covid Ag").Activate
Range("A38").Select
ActiveCell.FormulaR1C1 = "=HYPERLINK(CONCATENATE(R[1]C,R[2]C,R[3]C))"
Range("A38").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
[F17] = Date
[J17] = Time
Range("A35").Select
ActiveCell.FormulaR1C1 = "hoja1-"
Range("m35").Select
ActiveCell.FormulaR1C1 = "NEGATIVO"
nombre = Cells(40, 1).Value
Ruta = Cells(42, 1).Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Ruta & nombre, _
Quality:=xlQualityStandard, IncludedocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1
End Sub
los dos macros están en hojas diferentes no se cual es el problema???? ayuda por favor
Gracias de antemano