socorrooooooo

Iniciado por IMPERIAL, 23 Enero 2006, 16:37 PM

0 Miembros y 1 Visitante están viendo este tema.

Imprimir
Ir Abajo Páginas1
Acciones del Usuario

IMPERIAL

23 Enero 2006, 16:37 PM
aQUI TENGO UN PROGRAMITA QUE NO ME FUNCIONA , NO SE PORKE PUEDE SER, PODEIS MIRAR A VER QUE LE PASA PORFAVOOOORR, FUNCIONABA CUANDO ESTA EN EKIPOS CON WINDOWS NT, PERO CON WINDOWS XP NO VA, PORKE PUEDE SER.

Private Sub CommandButton1_Click()
'
' Macro creada el 04/12/03 por jvalls
'


'-----------------------------------------------------------------------
'Path de los ficheros
Dim pbop, pdirectorio, ptemporales As String
Dim guardar As String

'pbop = "T:\"   '<- Directorio de donde se coge el fichero que saca la aplicación
'pdirectorio = "c:\usuarios\copia\"  '<- Directorio donde estan los documentos
'ptemporales = "C:\usuarios\boptemp\" '<- OJO, Si se cambia, se tiene que cambiar el origen de datos de los documentos
'guardar = "A:\sdgcs.doc"    '<- Nombre y path del fichero a guardar
pbop = "c:\usuarios\"   '<- Directorio de donde se coge el fichero que saca la aplicación
pdirectorio = "c:\usuarios\copia\"  '<- Directorio donde estan los documentos
ptemporales = "C:\usuarios\boptemp\" '<- OJO, Si se cambia, se tiene que cambiar el origen de datos de los documentos
guardar = "C:\sdgcs.doc"    '<- Nombre y path del fichero a guardar
'-----------------------------------------------------------------------
On Error Resume Next
MkDir ptemporales 'Carpeta temporal

Dim tipoescrito, cabecera, lista, anupueblo, listapueblo As String

If Formulario.OptionButton1.Value = True Then  'Elegir tipo de escrito
   tipoescrito = "pr1112b.doc"
   cabecera = "anunciob.doc"
   lista = "id.doc"
   'lista = "pr1110x.doc"
   anupueblo = "anun1112b.doc"
   listapueblo = "pr1112l.doc"
Else
   If Formulario.OptionButton2.Value = True Then
      tipoescrito = "pr1112.doc"
      cabecera = "anuncio.doc"
      'lista = "pr1110x.doc"
      lista = "id.doc"
      anupueblo = "anun1112.doc"
      listapueblo = "pr1112l.doc"
   Else
      If Formulario.OptionButton3.Value = True Then
         tipoescrito = "pr1112c.doc"
         cabecera = "anuncioc.doc"
         'lista = "pr1110x.doc"
         lista = "id.doc"
         anupueblo = "anun1112c.doc"
         listapueblo = "pr1112l.doc"
       Else
         'lista = "recursol.doc"
         lista = "id.doc"
         cabecera = "anurecu.doc"
         tipoescrito = "alzada12.doc"
         anupueblo = "anrecu12.doc"
         listapueblo = "alza12l.doc"
       End If
   End If
End If
Formulario.OptionButton1.Enabled = False
Formulario.OptionButton2.Enabled = False
Formulario.OptionButton3.Enabled = False
Formulario.OptionButton4.Enabled = False
Formulario.CommandButton1.Enabled = False
Formulario.Tcargo.Enabled = False
Formulario.Tnombre.Enabled = False

Dim MyMerge As Word.MailMerge
Dim wrd As Object

Set wrd = CreateObject("Word.Application")
wrd.Visible = False

MsgBox wrd.ActiveDocument.Name
wrd.Documents.Open FileName:=pdirectorio & lista

' sssa = Openfile.lista
Set MyMerge = wrd.ActiveDocument.MailMerge
' sss = sssa.ActiveDocument.Subdocuments.Count
                If Application.Documents.Count >= 1 Then
                    MsgBox ActiveDocument.Name
                End If

With MyMerge
   
     .Destination = wdSendToNewDocument
     .Execute
End With

'----Fusionar escrito
wrd.Selection.InsertFile FileName:=pdirectorio & cabecera, Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False
'--------------------

Dim fecha As String
fecha = Format(Date, "d") & " de " & Format(Date, "MMMM") & " de " & Format(Date, "yyyy")

Set nou = wrd.ActiveDocument.Paragraphs  '-------Añadir fecha y firma
With nou
   .Add.Range.InsertAfter "Castellón de la Plana, " & fecha & Chr(11) & _
                        Tcargo.Value & "," & Chr(11) & Chr(11) & _
                        Chr(11) & Chr(11) & Chr(11) & Chr(11) & _
                        "Fdo.:" & Tnombre.Value
   .Add.Alignment = wdAlignParagraphCenter
End With
             

Dim paranada   'variable para recoger el resultado de msgbox
paranada = MsgBox("Introduzca un disquete para guardar la información.", vbOKOnly, "Atención")
wrd.ActiveDocument.SaveAs FileName:=guardar   'Guardar lista

wrd.Options.PrintBackground = False
wrd.ActiveDocument.PrintOut copies:=1  'Imprimir en impresora predeterminada

'Esperar a que imprima
Do While wrd.BackgroundPrintingStatus <> 0
   DoEvents
Loop

wrd.ActiveDocument.Close savechanges:=0
'///////////////////////////////////////////
wrd.Quit savechanges:=False
'///////////////////////////////////////////


'---FIN PR1110--------------------------------------------------------

'---PR1112------------------------------------------------------------

Set wrd = CreateObject("Word.Application")
wrd.Visible = False
wrd.Documents.Open(pbop & "bop.dat.doc").Tables(1).Sort ExcludeHeader:=True, FieldNumber:=35


Dim muni As String
Dim i As Integer
muni = ""
i = wrd.ActiveDocument.Tables(1).Rows.Count
While (i > 0)
   If (wrd.ActiveDocument.Tables(1).Rows(i).Cells(35) = muni) Then
      wrd.ActiveDocument.Tables(1).Rows(i).Delete
   Else
      muni = wrd.ActiveDocument.Tables(1).Rows(i).Cells(35)
   End If
   i = i - 1
Wend
   

wrd.ActiveDocument.SaveAs (ptemporales & "boppue.dat.doc")

wrd.ActiveDocument.Close
wrd.Documents.Open FileName:=pdirectorio & tipoescrito

Set nou = wrd.ActiveDocument.Paragraphs  '-------Añadir firma
With nou
   .Add.Range.InsertAfter Tcargo.Value & "," & Chr(11) & Chr(11) & _
                        Chr(11) & Chr(11) & Chr(11) & Chr(11) & _
                        "Fdo.:" & Tnombre.Value
   .Add.Alignment = wdAlignParagraphCenter
End With

Set MyMerge = wrd.ActiveDocument.MailMerge
With MyMerge
    .Destination = wdSendToNewDocument
    .Execute
End With


wrd.Options.PrintBackground = False
wrd.ActiveDocument.PrintOut copies:=1

'Esperar a que imprima
Do While wrd.BackgroundPrintingStatus <> 0
   DoEvents
Loop
wrd.ActiveDocument.Close savechanges:=0
'///////////////////////////////////////////
wrd.Quit savechanges:=False
'///////////////////////////////////////////


'------FIN pr1112-------------------------------------------------------

'------Lista pr1112-----------------------------------------------------
Set wrd = CreateObject("Word.Application")
wrd.Visible = False
wrd.Documents.Open (ptemporales & "boppue.dat.doc")

npu = wrd.ActiveDocument.Tables(1).Rows.Count
ReDim pueblos(npu) As String
i = 1

While (i <= wrd.ActiveDocument.Tables(1).Rows.Count)
      pueblos(i) = wrd.ActiveDocument.Tables(1).Rows(i).Cells(35)
      i = i + 1
Wend

wrd.ActiveDocument.Close
wrd.Documents.Open (pbop & "bop.dat.doc")

Dim j, filas As Integer
j = wrd.ActiveDocument.Tables(1).Rows.Count
filas = wrd.ActiveDocument.Tables(1).Rows.Count
i = 2  'No coger la cabecera


While (i <= npu)
   wrd.Quit savechanges:=False
   Set wrd = CreateObject("Word.Application")
   wrd.Visible = False
   wrd.Documents.Open (pbop & "bop.dat.doc")
   
   While (j > 1)
      If (wrd.ActiveDocument.Tables(1).Rows(j).Cells(35) <> pueblos(i)) Then
        wrd.ActiveDocument.Tables(1).Rows(j).Delete
      End If
      j = j - 1
   Wend
   
   wrd.Documents.Open (pdirectorio & "pueblo.doc")
   wrd.ActiveDocument.Tables(1).Rows(2).Cells(1) = pueblos(i)
   wrd.ActiveDocument.SaveAs (ptemporales & "pueblo.dat.doc")
   wrd.ActiveDocument.Close
   
   wrd.ActiveDocument.SaveAs (ptemporales & "lista.dat.doc")
   wrd.ActiveDocument.Close
   
   wrd.Documents.Open (pdirectorio & anupueblo)
   Set MyMerge = wrd.ActiveDocument.MailMerge
   With MyMerge
       .Destination = wdSendToNewDocument
       .Execute
   End With
   wrd.ActiveDocument.SaveAs (ptemporales & "anun1112.dat.doc")
   wrd.ActiveDocument.Close
   
   wrd.Documents.Open FileName:=pdirectorio & listapueblo
   Set MyMerge = wrd.ActiveDocument.MailMerge
   With MyMerge
       .Destination = wdSendToNewDocument
       .Execute
   End With
   wrd.Selection.InsertFile FileName:=ptemporales & "ANUN1112.dat.doc", Range:="", ConfirmConversions:=False, Link:=False, Attachment:=False

   Set nou = wrd.ActiveDocument.Paragraphs  '-------Añadir fecha y firma
   With nou
      .Add.Range.InsertAfter "Castellón de la Plana, " & fecha & Chr(11) & _
                        Tcargo.Value & "," & Chr(11) & Chr(11) & _
                        Chr(11) & Chr(11) & Chr(11) & Chr(11) & _
                        "Fdo.:" & Tnombre.Value
      .Add.Alignment = wdAlignParagraphCenter
   End With
   
   wrd.Options.PrintBackground = False
   wrd.ActiveDocument.PrintOut copies:=1
   
   'Esperar a que imprima
   Do While wrd.BackgroundPrintingStatus <> 0
      DoEvents
   Loop
   wrd.ActiveDocument.Close savechanges:=0

   
   j = filas
   i = i + 1
Wend

While (wrd.Documents.Count <> 0)
   wrd.ActiveDocument.Close savechanges:=False
Wend

'//////////////////////////////
wrd.Quit savechanges:=False
'//////////////////////////////

'Kill ptemporales & "*.*"
'RmDir ptemporales

Application.Quit savechanges:=False

End Sub





skapunky

#1
24 Enero 2006, 15:13 PM
Diria que el problema reside en las rutas de aperturas de ficheros. Supongo que lo sabras pero las carpetas y rutas son algo distintas en windows 98 o xp que en el sistema NT.

Las rutas que has escrito poco me suenan y quiza solo valgan para NT. Revisa eso, por lo demas no veo nada raro.

Saludos.

http://usuarios.lycos.es/skapunky/
Killtrojan Syslog v1.44: ENTRAR

IMPERIAL

#2
24 Enero 2006, 19:04 PM
Por las rutas no son tio, ya que en equipos con NT fuciona y con XP no chuta, y las unidades son las mismas en ambos equipos.

A mi lo que me rallaba un poco es que a lo mejor al carecer de alguna libreria en XP el programa no funcione bien debido a ello, ya que es raro que en NT funcione bien y en XP no, por eso me gustarai saber si es debido a alguna libreria o hay alguna fomra de realizar una migracion correcta, es que ya no se tio porke puede ser, si me pudieras hechar una mano o alguien que sepa dle tema :)

Saludos
Imprimir
Ir Arriba Páginas1
Acciones del Usuario