Macro que haga una serie de instrucciones en varias celdas y después las guarde con extensión .scr
Buenas días/tardes.
Tengo una hoja que trae coordenadas (Xinicial, Yinicial - Xfinal, Yfinal). Las cuales quiero traducir al lenguaje de AUTOCAD, por lo cual necesito que una macro extraiga los valores de las celdas y que las guarde en extensión .scr
Al abrir el archivo .scr tiene que dejar espacios o enter's (indicados por mi) entre las coordenadas.
Esto lo hago en una macro en word, pero el problema que tengo que copiar y pegar de excel a word. En word le indico los espacios y enter's que debe tener cada línea (fila) y así sucesivamente.
Envió imagen (dos líneas) de como tendría que ser el resultado cuando lo guarda en extensión .scr.
Saludos y espero no causar mucha confusión
1 respuesta
Suponiendo que tienes las coordenadas en las celdas A1, B1, C1 y D1.
Prueba con la siguiente macro:
Sub scr()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
Workbooks.Add
ActiveSheet.Range("A1") = "_leader"
ActiveSheet.Range("A2") = h1.[A1]
ActiveSheet.Range("A3") = h1.[B1]
ActiveSheet.Range("A6") = "n"
ActiveSheet.Range("A7") = "_leader"
ActiveSheet.Range("A8") = h1.[C1]
ActiveSheet.Range("A9") = h1.[D1]
ActiveSheet.Range("A12") = "n"
ActiveSheet.Range("A13") = " "
Columns("A:A").HorizontalAlignment = xlLeft
ActiveWorkbook.SaveAs Filename:="C:\doc.prn", _
FileFormat:=xlTextPrinter, CreateBackup:=False
ActiveWindow.Close
Name "C:\doc.prn" As "C:\doc.scr"
End SubEl archivo te lo guarda en C:\ con el nombre de doc.scr
Revisa el resultado y dime si es lo que necesitas.
Estaba probando y no es necesario renombrar el archivo, se puede guardar directamente con la extensión scr.
Prueba con esta
Sub scr()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
Workbooks.Add
ActiveSheet.Range("A1") = "_leader"
ActiveSheet.Range("A2") = h1.[A1]
ActiveSheet.Range("A3") = h1.[B1]
ActiveSheet.Range("A6") = "n"
ActiveSheet.Range("A7") = "_leader"
ActiveSheet.Range("A8") = h1.[C1]
ActiveSheet.Range("A9") = h1.[D1]
ActiveSheet.Range("A12") = "n"
ActiveSheet.Range("A13") = " "
Columns("A:A").HorizontalAlignment = xlLeft
ActiveWorkbook.SaveAs Filename:="C:\doc.scr", _
FileFormat:=xlTextPrinter, CreateBackup:=False
ActiveWindow.Close
End Sub
