|
Mostrar Mensajes
|
Páginas: [1]
|
1
|
Programación / Programación Visual Basic / Re: Duda [VBA] Reemplazar una fecha por otra en la cabecera
|
en: 12 Febrero 2015, 10:52 am
|
Al final tras investigar y preguntar por otros sitios lo he conseguido Para el que le interese hay le va el codigo : Este para abrir en varios words, lo guardas en una plantilla Sub openf() Dim FSO As Object Dim fPath As String Dim myFolder, myFile Dim wdApp As Object Dim wdDoc As Variant
fPath = "C:\" 'change to your directory Set wdApp = GetObject(, "Word.Application") Set FSO = CreateObject("Scripting.FileSystemObject") Set myFolder = FSO.GetFolder(fPath).Files For Each myFile In myFolder If LCase(myFile) Like "*.docx" Then 'change to you file type Set wdDoc = wdApp.Documents.Open(CStr(myFile)) wdApp.Visible = True FindAndReplaceFirstStoryOfEachType wdDoc.Save wdDoc.Close Set wdDoc = Nothing End If Next myFile
End Sub
Y luego este que modifica la cabecera: Sub FindAndReplaceFirstStoryOfEachType()
If ActiveWindow.View.SplitSpecial <> wdPaneNone Then ActiveWindow.Panes(2).Close End If If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ ActivePane.View.Type = wdOutlineView Then ActiveWindow.ActivePane.View.Type = wdPrintView End If ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader Selection.MoveRight Unit:=wdCharacter, Count:=14 Selection.MoveDown Unit:=wdLine, Count:=1 Selection.MoveRight Unit:=wdCharacter, Count:=3 Selection.MoveLeft Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.Delete Unit:=wdCharacter, Count:=1 Selection.TypeText Text:=Format(Now(), "dd/mm/yyyy") Selection.MoveLeft Unit:=wdCharacter, Count:=4 Selection.TypeBackspace Selection.TypeText Text:="/" End Sub
|
|
|
2
|
Programación / Programación Visual Basic / Re: Duda [VBA] Reemplazar una fecha por otra en la cabecera
|
en: 11 Febrero 2015, 11:33 am
|
Hasta ahora solo he conseguida modificar la fecha y cambiarlo en el formato correcto Sub FindAndReplaceFirstStoryOfEachType() Set objRegEx = CreateObject("vbscript.regexp") objRegEx.Global = True objRegEx.IgnoreCase = True objRegEx.MultiLine = True objRegEx.Pattern = "[0-9]{2}/[0-9]{2}/[0-9]{4}"
Dim rngStory As Range For Each rngStory In ActiveDocument.StoryRanges If Not IsEmpty(rngStory) Then With rngStory.Find If objRegEx.test(rngStory) = True Then
.Text = CStr(rngStory) .Replacement.Text = Format(now(), "mm/dd/yyyy") .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End If End With
End If Next rngStory End Sub Tambien he sacado un codigo para modificar la cabecera: ActiveDocument.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader El problema esta en que no me deja moverme por la cabecera, es decir, solo me modifica la primera celda de la cabecera. Ayuda por favor, no hay manera de que funcione
|
|
|
3
|
Programación / Programación Visual Basic / Duda [VBA] Reemplazar una fecha por otra en la cabecera
|
en: 10 Febrero 2015, 12:40 pm
|
Hola de nuevo, Hace poco pedí ayuda para un vbs aquí y me lo solucionasteis muy rapido y bien, ahora otra vez ando con un problema parecido aunque esta vez es vba. He estado mirando todo lo que he podido pero no he encontrado nada que me aclarase, si cosas parecidas pero no algo que me ayudara a acabarlo Estoy intentando ver si puedo hacer un vba que reemplace la fecha de una cabecera por otra en varios documento .doc El tema esta en que remplazara la fecha de la cabecera ( con este formato: 22/02/2014 ) por otra del mismo formato. La entrada de la fecha por la que se va a remplazar me da igual que este en el mismo script o que la pida al ejecutar. Hasta ahora tengo hecho algo asi: Sub FindAndReplaceFirstStoryOfEachType() Set objRegEx = CreateObject("vbscript.regexp") objRegEx.Global = True objRegEx.IgnoreCase = True objRegEx.MultiLine = True Set wdDoc = wdApp.Documents.Open("C:\Nueva carpeta\*.doc") With wdDoc.Content.Find .Text = "([1-31]{1,3})/([1-12]{1,3})/([2010-2016]{10,20})" .Replacement.Text = "<fecha actual>" .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll End With End Sub He probado varias cosas y no doy con el formato adecuado en .Text para que me lo remplace y no consiguo que se aplique a la cabecera. Espero que me podias ayudar tan bien como la ultima vez Saludos
|
|
|
4
|
Programación / Scripting / Re: Duda con sript vbs
|
en: 23 Enero 2015, 15:22 pm
|
OK funciona a la perfeccion, he estado intentando hacer una pequeña variacion, un codigo que me envie solo en un email las particiones por debajo per 10 poniendo un if isEmpty antes del sendMail pero no me ha salido, en fin asi se me va a quedar que el que me habeis dado va de perlas Muchas gracias a los dos por la ayuda Saludos
|
|
|
6
|
Programación / Scripting / Re: Duda con sript vbs
|
en: 22 Enero 2015, 15:31 pm
|
No entiendo bien, quieres que añada el call sendemail para llamar al procedimiento de mi vbs o que haga uno nuevo y que meta eso para llamarlo?.. seguro que sera facil lo que me dices pero entre que estoy hecho un lio y aparte que no se me da nada bien esto del vbs no lo entiendo salu2
|
|
|
7
|
Programación / Scripting / Re: Duda con sript vbs
|
en: 22 Enero 2015, 10:23 am
|
Perdon Perdon Shell root si esta bien si si no encuentra ninguna particion por debajo envia el correo vacio Espero que no te importe que te pregunte..¿Hay alguna forma de que no envie ningun correo si no encuentra ninguna particion por debajo de los 10gb? ¿Asi de pronto se me ocurre un "si esta vacio" el mensaje pero no se bien como hacerlo, me pondre a ello haber si me sale (aunque lo dudo ¬¬) Gracias de nuevo
|
|
|
8
|
Programación / Scripting / Re: Duda con sript vbs
|
en: 22 Enero 2015, 09:33 am
|
Hasta aquí te lo dejo bien, SET oWMI = GetObject("winmgmts:\\.\root\cimv2") SET oItems = oWMI.ExecQuery("SELECT * FROM Win32_Volume WHERE DriveType = 3") Dim oFSpace, oFREESpace For Each oItem In oItems oFSpace = oItem.FreeSpace oFSpace = (oFSpace/ (1024^3)) oFREESpace = cDbl(oItem.FREESpace) ' Me generaba un error porque [oItem.DriveLetter] me ' devolvia una string Null asi que utilice la función ' [IsNull] para validarlo. If oFSpace < 10 And IsNull(oItem.DriveLetter) = False Then MsgBox "La unidad: " & oItem.DriveLetter & " tiene un espacio de: " & FormatSpace(oFREESpace) End If Next Function FormatSpace(oSpace) oSpace = oSpace/1024 oSpace = oSpace/1024 oSpace = oSpace/1024 oSpace= FormatNumber(oSpace, 1) FormatSpace = oSpace end Function
Lo primero, muchas gracias por la ayuda e interes, Y lo segundo, hasta donde llego yo (que es poco xD) lo que hace es que si llega DriveLetter vacio osea que no coge nada no de error con el IsNull, pero lo que me interesa saber por que no me coje nada de ahi porque si lo dejas asi te manda un correo en blanco =S Saludos
|
|
|
9
|
Programación / Scripting / Duda con sript vbs
|
en: 21 Enero 2015, 14:34 pm
|
Buenas! Os comento, para ser sincero nunca he programado en vbs hasta hace unos dias he tenido que hacer un vbs que me sacara el espacio libre de las particiones y que en caso de estar por debajo de 10GB lo mandase por correo El caso es que mirando esto el tuto de esta pagina http://foro.elhacker.net/scripting/tutorial_vbscript-t229032.0.html y varias paginas mas consegui hacer uno que funcionase en mi pc correctamente, hasta ahi todo bien pero cuando pruebo en otro pc diferente sale error El codigo es: Set objWMIService = GetObject( "winmgmts:\\.\root\cimv2" ) Set colItems = objWMIService.ExecQuery ("Select * From Win32_Volume Where DriveType = 3") For Each objItem In colItems FSpace=objItem.FreeSpace FSpace = (FSpace / 1024^3) ispc2 = cDbl(objItem.FREESpace) if FSpace < 10 Then msg = "1" texto = "La unidad: " & objItem.DriveLetter & " Tiene un espacio libre menor de 10GB, tiene un total de " & FormatiSpc(ispc2) & " GB libres | " text = text & vbNewLine & texto end if Next Function FormatiSpc(intSpace) intSpace = intSpace/1024 intSpace = intSpace/1024 intSpace = intSpace/1024 intSpace= FormatNumber(intSpace,1) FormatiSpc = intSpace end Function msg = strComputerName & vbNewLine & text if msg <> "" then sendMAIL(msg) end if Sub sendMAIL(msg) Dim strbody strbody = msg + chr(13) + chr(10) set objcdo=createobject("cdo.message") objcdo.subject="Espacio libre en particiones" objcdo.from="kortiz@wisco.es" objcdo.to="kortiz@wisco.es" objcdo.textbody= strbody objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.2.230" objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 objcdo.configuration.fields.item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1 objcdo.configuration.fields.update objcdo.send End Sub
Seguro que habrá varias cosas mal pero yo no las veo, como ya digo soy un principiante en esto del vbs, el caso es que no veo que falla, en mi pc va perfecto y en el otro da eses error que es como si no guardase nada de colItem Espero que me podais ayudar, he estado probando varias cosas y nada... Saludos
|
|
|
|
|
|
|