Macro me genera problemas con otra macro

edgarivan6 · el 26 de marzo

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