Visual Basic - Convertir formulario en pdf con vb 6.0

Life is soft - evento anual de software empresarial
   
Vista:

Convertir formulario en pdf con vb 6.0

Publicado por Javier (4 intervenciones) el 04/09/2017 01:24:11
buenas tardes amigos necesito de su enorme ayuda porque estoy tratando de transformar un formulario con sus datos en pdf y no se como hacerlo... he revisado algunos articulo donde hablan de usar las impresoras virtuales pero no entendi como trabajarlas veo que mencionan mucho pdfcreater pero como se llama el componente ocx o dll para agregarlo en visaul basic y poderlo trabajar?, de hecho revise el ejemplo que trae por defecto el pdfcreater pero al ejecutarlo desde visaul basic 6.0 genera un error... consegui otro componente pdfcom.dll este lo agregue por la ventana de componentes de visaul basic peroo no se como crear el pdf desde ahi.... bueno aqui les dejo el codigo de mi formulario... les agradezco su gran ayuda y orientacion...gracias de antemano amigos....

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
Public valor, cad_num_presupuesto, cad_id, aux_rif, aux_id_insum, aux_id_present, aux_num_presup, aux_descrip_insum, id_presup As String
Public i, j As Integer
Public encontrado As Boolean
 
Private Sub btn_actualizar_Click()
If MsgBox("desea actualizar el contenido", vbYesNo, "Actualizar") = 6 Then
    i = 1
    aux_num_presup = Trim(num_presup.Caption)
    Set rs_p = New ADODB.Recordset
      SQL = "select * from presupuesto where num_presupuesto like '%" & Trim(aux_num_presup) & "%' order by id"
      rs_p.Open SQL, db, , , adCmdText
    If Not rs_p.EOF Then
      rs_p.MoveFirst
      While Not rs_p.EOF
        aux_descrip_insum = Trim(MSFlexGrid4.TextMatrix(i, 2))
        Set rs_i = New ADODB.Recordset
          SQL = "select * from insumo where descripcion like '%" & Trim(aux_descrip_insum) & "%' order by id_insumo"
          rs_i.Open SQL, db, , , adCmdText
        aux_id_insum = Trim(rs_i![id_insumo])
 
        aux_id_presup = Trim(rs_p![id])
        If MSFlexGrid4.TextMatrix(i, 2) <> "" Then
          'If aux_num_presup = Trim(rs_p![num_presupuesto]) Then
            SQL = "UPDATE presupuesto SET fecha_emision='" & Trim(fech_elab.Text) & "', fecha_vencimiento='" & Trim(fech_vencim.Text) & "', responsable='" & Trim(respons.Text) & "', telefonos='" & Trim(telf_contac.Text) & "', oficina='" & Trim(ofici.Text) & "', celular='" & Trim(telf_cel.Text) & "', num_circuito='" & Trim(num_circui.Text) & "'," _
              & "id_insumo='" & Trim(aux_id_insum) & "', cantidad='" & Trim(MSFlexGrid4.TextMatrix(i, 4)) & "', precio='" & Trim(MSFlexGrid4.TextMatrix(i, 5)) & "', rif='" & Trim(rif.Text) & "' where id like '%" & Trim(aux_id_presup) & "%'"
              db.Execute SQL, sopt
          'End If
        End If
        i = i + 1
        rs_p.MoveNext
      Wend
    End If
 
  Set rs_c = New ADODB.Recordset
    SQL = "UPDATE cliente SET razon_social='" & Trim(razon_social.Text) & "', rif='" & Trim(rif.Text) & "', direccion='" & Trim(direcc_clien.Text) & "', contacto='" & Trim(contac.Text) & "', telefonos='" & Trim(telf_clien.Text) & "', correo_electronico='" & Trim(email_clien.Text) & "' where rif like '%" & Trim(rif.Text) & "%' "
    db.Execute SQL, sopt
 
  rs_i.Close
  rs_p.Close
  MsgBox "Actualización Exitosa...", vbInformation, "REGISTRO DATOS ESTABLECIMIENTO"
End If
Call limpiar
End Sub
 
Private Sub btn_buscar_Click()
Dim val As String
 
val = InputBox("INGRESE NUMERO DE PRESUPUESTO...            Ejemplo:    E-CDR-LAR-0507-17", "BUSQUEDA PRESUPUESTO")
If val <> "" Then
  Set rs_p = New ADODB.Recordset
    SQL = "select * from presupuesto where num_presupuesto='" & Trim(val) & "'"
    rs_p.Open SQL, db, , , adCmdText
    If Not rs_p.EOF Then
      rs_p.MoveFirst
      i = 1
      While Not rs_p.EOF
        If Trim(rs_p![num_presupuesto]) = val Then
          num_presup.Caption = Trim(rs_p![num_presupuesto])
          fech_elab.Text = Trim(rs_p![fecha_emision])
          fech_vencim.Text = Trim(rs_p![fecha_vencimiento])
          respons.Text = Trim(rs_p![responsable])
          telf_contac.Text = Trim(rs_p![telefonos])
          ofici.Text = Trim(rs_p![oficina])
          telf_cel.Text = Trim(rs_p![celular])
          num_circui.Text = Trim(rs_p![num_circuito])
          rif.Text = Trim(rs_p![rif])
          If IsNull(Trim(rs_p![cantidad])) Then
            MSFlexGrid4.TextMatrix(i, 4) = ""
          Else
            MSFlexGrid4.TextMatrix(i, 4) = Trim(rs_p![cantidad])
          End If
          If IsNull(Trim(rs_p![precio])) Then
            MSFlexGrid4.TextMatrix(i, 5) = ""
          Else
            MSFlexGrid4.TextMatrix(i, 5) = Trim(rs_p![precio])
          End If
          aux_rif = Trim(rs_p![rif])
          aux_id_insum = Trim(rs_p![id_insumo])
 
          Set rs_c = New ADODB.Recordset
            SQL = "select * from cliente where rif like '%" & aux_rif & "%' order by rif"
          rs_c.Open SQL, db, , , adCmdText
 
          If Not rs_c.EOF Then
            razon_social.Text = Trim(rs_c![razon_social])
          Else
            razon_social.Text = ""
          End If
          If Not rs_c.EOF Then
            direcc_clien.Text = Trim(rs_c![direccion])
          Else
            direcc_clien.Text = ""
          End If
          If Not rs_c.EOF Then
            contac = Trim(rs_c![contacto])
          Else
            contac = ""
          End If
          If Not rs_c.EOF Then
            telf_clien = Trim(rs_c![telefonos])
          Else
            telf_clien = ""
          End If
          If Not rs_c.EOF Then
            email_clien = Trim(rs_c![correo_electronico])
          Else
            email_clien = ""
          End If
 
          Set rs_i = New ADODB.Recordset
            SQL = "select * from insumo order by id_insumo"
          rs_i.Open SQL, db, , , adCmdText
          rs_i.MoveFirst
          If Not rs_i.EOF Then
            While Not rs_i.EOF
              If aux_id_insum = Trim(rs_i![id_insumo]) Then
                MSFlexGrid4.TextMatrix(i, 2) = Trim(rs_i![descripcion])
                aux_id_present = Trim(rs_i![id_presentacion])
 
                Set rs_d = New ADODB.Recordset
                  SQL = "select * from presentacion"
                rs_d.Open SQL, db, , , adCmdText
                rs_d.MoveFirst
                If Not rs_d.EOF Then
                  While Not rs_d.EOF
                    If aux_id_present = Trim(rs_d![id_presentacion]) Then
                      MSFlexGrid4.TextMatrix(i, 3) = Trim(rs_d![nombre_presentacion])
                    End If
                    rs_d.MoveNext
                  Wend
                End If
              End If
              rs_i.MoveNext
            Wend
          End If
          i = i + 1
          rs_p.MoveNext
        End If
      Wend
      rs_d.Close
      rs_p.Close
      rs_c.Close
      rs_i.Close
    End If
Else
  MsgBox "DEBE ESCRIBIR UN NUMERO DE PRESUPUESTO", vbExclamation
End If
End Sub
 
Private Sub btn_cancelar_Click()
Call limpiar
End Sub
 
Private Sub btn_guardar_Click()
Dim aux_i As String
 
If MsgBox("desea guardar el contenido", vbYesNo + vbQuestion, "Inclusión") = 6 Then
  Set rs_c = New ADODB.Recordset
    SQL = "select * from cliente where rif not like '%" & Trim(rif.Text) & "%' order by rif"
    rs_c.Open SQL, db, , , adCmdText
    SQL = "insert into cliente(id,razon_social,rif,direccion,contacto,telefonos,correo_electronico)" _
      & "values('" & Trim(cad_id) & "','" & Trim(razon_social.Text) & "','" & Trim(rif.Text) & "','" & Trim(direcc_clien.Text) & "','" & Trim(contac.Text) & "','" & Trim(telf_clien.Text) & "','" & Trim(email_clien.Text) & "')"
      db.Execute SQL, sopt
    rs_c.Close
 
  For i = 1 To (MSFlexGrid4.Rows - 1)
    If MSFlexGrid4.TextMatrix(i, 2) <> "" Then
      Set rs_i = New ADODB.Recordset
        SQL = "select * from insumo order by id_insumo"
      rs_i.Open SQL, db, , , adCmdText
      If Not rs_i.EOF Then
        rs_i.MoveFirst
        encontrado = False
        While Not rs_i.EOF And Not encontrado
          If Trim(MSFlexGrid4.TextMatrix(i, 2)) = Trim(rs_i![descripcion]) Then
 
            aux_i = Trim(rs_i![id_insumo])
            SQL = "insert into presupuesto(num_presupuesto,fecha_emision,fecha_vencimiento,responsable,telefonos,oficina,celular,num_circuito,id_insumo,cantidad,precio,id,rif)" _
                & "values('" & Trim(num_presup.Caption) & "','" & Trim(fech_elab.Text) & "','" & Trim(fech_vencim.Text) & "','" & Trim(respons.Text) & "','" & Trim(telf_contac.Text) & "','" & Trim(ofici.Text) & "','" & Trim(telf_cel.Text) & "','" & Trim(num_circui.Text) & "','" & Trim(aux_i) & "','" & Trim(MSFlexGrid4.TextMatrix(i, 4)) & "','" & Trim(MSFlexGrid4.TextMatrix(i, 5)) & "','" & Trim(cad_id) & "','" & Trim(rif.Text) & "')"
            db.Execute SQL, sopt
            encontrado = True
          End If
          rs_i.MoveNext
        Wend
        rs_i.Close
      End If
    End If
  Next i
  MsgBox "Inclusion Exitosa...", vbInformation, "REGISTRO PRESUPUESTO"
End If
Call limpiar
End Sub
 
Private Sub btn_salir_Click()
Unload Me
End Sub
 
Private Sub cmb_descrip_Click()
valor = cmb_descrip.Text
Set rs_d = New ADODB.Recordset
 SQL = "select * from insumo order by id_insumo"
 rs_d.Open SQL, db, , , adCmdText
 If Not rs_d.EOF Then
   rs_d.MoveFirst
   While Not rs_d.EOF
   If Trim(valor) = Trim(rs_d![descripcion]) Then
     aux_d = Trim(rs_d![id_presentacion])
   End If
   rs_d.MoveNext
   Wend
 End If
 MSFlexGrid4.Text = cmb_descrip.Text
 cmb_descrip.Visible = False
 cmb_present.Clear
 
 Set rs_p = New ADODB.Recordset
    SQL = "select * from presentacion order by id_presentacion"
    rs_p.Open SQL, db, , , adCmdText
    If Not rs_p.EOF Then
      rs_p.MoveFirst
      While Not rs_p.EOF
        If Trim(rs_p![id_presentacion]) = Trim(aux_d) Then
          cmb_present.AddItem Trim(rs_p![nombre_presentacion])
        Else
          cmb_present.Text = " "
        End If
        rs_p.MoveNext
      Wend
    End If
 
rs_d.Close
rs_p.Close
End Sub
 
Private Sub cmb_present_Click()
MSFlexGrid4.Text = cmb_present.Text
cmb_present.Visible = False
End Sub
 
Private Sub Form_Load()
Set db = New ADODB.Connection
 db.Open "PROVIDER=MSDASQL;dsn=PostgreSQL30;uid=postgres;pwd=987654;database=Presupuesto_RedVen;"
 sopt = dbsqlPassTrough
 
cmb_descrip.Visible = False
 
Set rs_d = New ADODB.Recordset
 SQL = "select * from insumo order by id_insumo"
 rs_d.Open SQL, db, , , adCmdText
 rs_d.MoveFirst
 If Not rs_d.EOF Then
   While Not rs_d.EOF
     cmb_descrip.AddItem Trim(rs_d![descripcion])
     rs_d.MoveNext
   Wend
 End If
rs_d.Close
cmb_present.Visible = False
 
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
db.Close
End Sub
 
Private Sub MSFlexGrid4_Click()
If cmb_descrip.Visible = True Then
  cmb_descrip.Visible = False
End If
If cmb_present.Visible = True Then
  cmb_present.Visible = False
End If
 
If MSFlexGrid4.Col = 2 Then
  cmb_descrip.Top = MSFlexGrid4.Top + MSFlexGrid4.CellTop
  cmb_descrip.Width = MSFlexGrid4.CellWidth
  cmb_descrip.Left = MSFlexGrid4.CellLeft + MSFlexGrid4.Left
  cmb_descrip.Visible = True
End If
If MSFlexGrid4.Col = 3 Then
  cmb_present.Top = MSFlexGrid4.Top + MSFlexGrid4.CellTop
  cmb_present.Width = MSFlexGrid4.CellWidth
  cmb_present.Left = MSFlexGrid4.CellLeft + MSFlexGrid4.Left
  cmb_present.Visible = True
End If
End Sub
 
Private Sub MSFlexGrid4_KeyPress(KeyAscii As Integer)
Dim T As String
 
T = MSFlexGrid4.Text
If KeyAscii = 8 Then
  If Len(T) > 0 Then T = Left(T, Len(T) - 1)
  Else
    T = T + Chr(KeyAscii)
  End If
  MSFlexGrid4.Text = T
End Sub
 
Private Sub VScroll1_Change()
    SSTab1.Top = -VScroll1.Value
End Sub
 
Private Sub limpiar()
razon_social.Text = ""
rif.Text = ""
direcc_clien.Text = ""
contac.Text = ""
telf_clien.Text = ""
email_clien.Text = ""
 
fech_elab.Text = ""
fech_vencim.Text = ""
respons.Text = ""
telf_contac.Text = ""
ofici.Text = ""
telf_cel.Text = ""
num_circui.Text = ""
 
MSFlexGrid4.Clear
End Sub
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de Antoni Masana

Convertir formulario en pdf con vb 6.0

Publicado por Antoni Masana (319 intervenciones) el 04/09/2017 10:11:00
En las últimas versiones de Windows y Office vienen con una impresora virtual que genera ficheros PDF.
Para solucionar el problema tienes que hacer igual que si la impresión fuese en papel pero seleccionando la impresora PDFCreator, el nombre podría ser diferente según la versión.

Este codigo lo uso para que el programa busque la impresora PDF y si no existe da un aviso.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim Prt As Printer, PDF As Boolean, PRN_Actual As String
...
PRN_Actual = Printer.DeviceName
If Out_PDF.Value Then    ' --- Tengo la opción de impresora o PDF
   PDF = False
   For Each Prt In Printers
       If InStr(Prt.DeviceName, "PDF") > 0 Then Set Printer = Prt: PDF = True
   Next
   If Not PDF Then Call Aviso: Exit  Sub
End if
...
Printer.EndDoc
For Each Prt In Printers
    If Prt.DeviceName = PRN_Actual Then Set Printer = Prt
Next

Guarda la impresora por defecto.
Busca alguna impresora que en el nombre tenga el texto PDF y la establece como predeterminada
Si no la encuentra Sale.
Al finalizar la impresión restaura la impresora por defecto.

Saludos.
\\//_
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
2
Comentar

Convertir formulario en pdf con vb 6.0

Publicado por Javier (4 intervenciones) el 04/09/2017 14:41:50
oy amigo muchas gracias por la orientacion.....mil gracias compa saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Revisar política de publicidad