Rango excel a txt (bloc de notas) sin crear libro add
Tengo es que código que busque en internet el cual es lo que necesito pero presenta dos problemas
Sub Rango_a_Bloc_de_notas1()
Sheets("Cambios"). Range("n1:O8"). Copy 'Celda de la región actual
Shell "notepad.exe", vbNormalFocus
SendKeys "^v"
Close
End Sub1. Me apaga los mayusculas y el bloq num
2. Quisiera poner nombre al bloc de notas
Para resolver los del teclado numérico, agrega el siguiente código al inicio del modulo, afuera de cualquier rutina:
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Long
y luego modifica tu codigo para que quede de la siguiente manera:
Sub Rango_a_Bloc_de_notas1()
Sheets("Cambios"). Range("n1:O8"). Copy 'Celda de la región actual
Shell "notepad.exe", vbNormalFocus
SendKeys "^v"
Close
If GetKeyState(144) = 0 Then SendKeys "{NUMLOCK}"
End SubEn relacion a nombrar el archivo de texto te sugiero (aunque agregues un libro nuevo) que lo hagas de esta manera, asi es mas sencillo. Tendrias que cambiar todo tu codigo:
Sub test()
Dim w As Workbook
ThisWorkbook.Sheets("Cambios").Range("n1:O8").Copy
Set w = Workbooks.Add
w.Sheets(1).Paste
w.SaveAs Filename:="C:\Users\Desktop\1prueba.txt", FileFormat:=xlUnicodeText
w.Close False
End Sub
Hola
Puse el primer código el que modificaste
Y me salio esto:
La línea de código que tienes en rojo debe de ir al inicio de cualquier rutina, intenta primero esta opción.
me sale esto ahora
Modifícalo para que quede de esta manera
Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As LongPtr) As LongPtr
nada mi estimado.... sigue apagandome el bloq num y el mayus
te voy a valorara de todas maneras
pero espero me ayudes
El problema es el sendkeys que utilizas, por eso te sugería la otra manera (workbooks. Add). Yo le he solucionado de la manera que hemos estado viendo yes la única manera que he encontrado hasta el momento.
1 respuesta más de otro experto
En la macro puedes, poner la hoja, el rango, el nombre y la ruta del archivo
Sub Exportar_a_Txt()
'Por.Dante Amor
nFileNum = FreeFile
nombrearchivo = "prueba"
rutaarchivo = ThisWorkbook.Path & "\" & nombrearchivo & ".txt"
Set h = Worksheets("Cambios")
Set r = h.Range("N1:O8")
Open rutaarchivo For Output As #nFileNum
fini = r.Cells(1, 1).Row
ffin = r.Rows.Count + ffin
cini = r.Cells(1, 1).Column
cfin = r.Columns.Count + cini - 1
For i = fini To ffin
For j = cini To cfin
salida = salida & h.Cells(i, j) & vbTab
Next
salida = Left(salida, Len(salida) - 1)
Print #nFileNum, salida
salida = Empty
Next
Close #nFileNum
MsgBox "Fin"
End SubRevisa la salida y dime si es lo que necesitas
sal u dos
hola dan
lo ejecuto
y solo me sale el mensaje de FIN
y no muestra el archivo txt ni nada
¿Tienes datos en las celdas de N1 a O8?
El archivo se queda en la carpeta, tienes que ir a la carpeta y abrirlo, el archivo se llama "prueba.txt"
si ya lo busque, pero no se abre como vista previa para consultaro al momento de ejecutarlo?
Pero eso no decía tu petición.
Agrega lo siguiente para abrir el archivo, y no es una vista previa, más bien estás abriendo el archivo.
Sub Exportar_a_Txt()
'Por.Dante Amor
nFileNum = FreeFile
nombrearchivo = "prueba"
rutaarchivo = ThisWorkbook.Path & "\" & nombrearchivo & ".txt"
Set h = Worksheets("Cambios")
Set r = h.Range("N1:O8")
Open rutaarchivo For Output As #nFileNum
fini = r.Cells(1, 1).Row
ffin = r.Rows.Count + ffin
cini = r.Cells(1, 1).Column
cfin = r.Columns.Count + cini - 1
For i = fini To ffin
For j = cini To cfin
salida = salida & h.Cells(i, j) & vbTab
Next
salida = Left(salida, Len(salida) - 1)
Print #nFileNum, salida
salida = Empty
Next
Close #nFileNum
ActiveWorkbook.FollowHyperlink rutaarchivo
End Sub