generar pdf desde asp

[dblanco]

Buenas,

os paso este código que he generado para escribir en PDF automáticamente una Tabla con los recordsets que deseemos. El tamaño de la fuente se ajusta automáticamente a un A4 apaisado.

Código:

<% Response.Expires = 0 %>
<!-- #include file="fpdf.asp" -->

<%
Dim pdf, rs, strSQL, px, mm, fill, campo, espacios
Dim x, y
Dim ancho()
Dim cabecera()
Dim data()
Set pdf=CreateJsObject("FPDF")
pdf.CreatePDF "L","mm","A4"
pdf.SetPath("fpdf/")
pdf.SetFont "Arial"
pdf.Open()
pdf.AddPage()
llenar_tablas()
escribir_tablas()
pdf.Close()
pdf.Output()

function llenar_tablas()
	set rs = Server.CreateObject("ADODB.Recordset")
	strSQL = "SELECT * FROM <tu_tabla>"
	rs.Open strSQL, <tu_conexion>
	x = 0
	for each campo in rs.Fields
		redim preserve cabecera(x)
		cabecera(x) = ucase(campo.Name)
		redim preserve ancho(x)
		ancho(x) = len(cabecera(x))
		x = x + 1
	next
	y = 0
	Do While Not(rs.EOF)
		x = 0
		for each campo in rs.Fields
			if len(campo.Value) > ancho(x) then ancho(x) = len(campo.Value)
			redim preserve data(y)
			data(y) = campo.Value
			x = x + 1
			y = y + 1
		next
		rs.MoveNext
	Loop
	rs.close
	set rs = nothing
	for x = 0 to ubound(ancho)
		espacios = espacios + ancho(x)
	next
	if 282/espacios <= 1.1 then
		px = 4
		mm = 1.1
	elseif 282/espacios <= 1.5 then
			px = 5
			mm = 1.45
	elseif 282/espacios <= 1.6 then
			px = 6
			mm = 1.55
	elseif 282/espacios <= 1.9 then
			px = 7
			mm = 1.80
	elseif 282/espacios <= 2.1 then
			px = 8
			mm = 2.05
	elseif 282/espacios <= 2.3 then
			px = 9
			mm = 2.20
	else
			px = 10
			mm = 2.54
	end if
	for x = 0 to ubound(ancho)
		if ancho(x) > 5 then
			ancho(x) = int(ancho(x) * mm)
		else
			ancho(x) = 8
		end if
	next
end function

function escribir_tablas()
    'Colores, ancho de línea y fuente en negrita
	pdf.SetTextColor 255
    pdf.SetDrawColor 0,0,0
	pdf.SetFillColor 255,0,0
    pdf.SetLineWidth 0.1
    pdf.SetFont "","B",px

    'Cabecera
    for x = 0 to ubound(cabecera)
        pdf.Cell ancho(x),5,cabecera(x),1,0,"C",1
	next
    pdf.Ln()
    
  	'Restauración de colores y fuentes
    pdf.SetFillColor 224,235,255
   	pdf.SetTextColor 0 
    pdf.SetFont ""
	
	'Datos
	x  = 0
	fill = 0
	do while x < ubound(data)
		for y = 0 to ubound(cabecera)
            pdf.Cell ancho(y),5,data(x+y),1,0,"L", fill
		next
	    pdf.Ln()
		x = x + ubound(cabecera) + 1
		if fill = 0 then
			fill = 1
		else
			fill = 0
		end if
	loop
end function
%>

espero que le sea útil a más de uno.

Saludos