¿Cómo modificar código VB para imprimir todos o solo los registros seleccionados de un listbox a un formato prestablecido?(DAM)

Puedes poner aquí el código.

Hola Dante Amor, aquí tienes el código del optionbutton para seleccionar todos los registros del listbox y el código del botón para imprimir.

No me lo has pedido, pero con la finalidad de que lo puedas observar mejor, me tomé la libertad de enviarte mi archivo completo a tu correo, en el asunto escribí el nombre de mi pregunta.  Gracias por tu tiempo.

Private Sub OptionButton1_Click()
'Por.DAM
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next
End Sub

Private Sub CommandButton1_Click()
'Por.Dante Amor

Application.ScreenUpdating = False
Set h1 = Sheets("FORMATO")
Set h2 = Sheets("IMPRESION")
Set h3 = Sheets("temp")
h2.Cells.Clear
h3.Cells.Clear
h3.Cells.UnMerge
h2.DrawingObjects.Delete
h2.Cells.Rows.RowHeight = 15
h2.ResetAllPageBreaks

h1.Rows("1:14").Copy h2.Range("A1")
h2.[B4] = TextBox4
h2.[B6] = TextBox6
h2.[B8] = TextBox13
h2.[B10] = TextBox5
h2.[B12] = TextBox2
h2.[H4] = TextBox1
h2.[H6] = TextBox3
h2.[H12] = TextBox14
j = 2
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) Then
h3.Cells(j, "J") = ListBox1.List(i, 0)
h3.Cells(j, "K") = ListBox1.List(i, 1)
h3.Cells(j, "L") = ListBox1.List(i, 5)
j = j + 1
n = n + 1
End If
Next
u = h3.Range("J" & Rows.Count).End(xlUp).Row
h3.Range("J1:L1") = Array("A", "B", "C")
h3.Range("J1:J" & u).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=h3.Range("M1"), Unique:=True

u = h3.Range("J" & Rows.Count).End(xlUp).Row
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:="temp!R1C10:R" & u & "C12", _
Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:="temp!R5C14", TableName:="Tabla dinámica2", _
DefaultVersion:=xlPivotTableVersion12

With h3.PivotTables("Tabla dinámica2").PivotFields("A")
.Orientation = xlRowField
.Position = 1
End With
With h3.PivotTables("Tabla dinámica2").PivotFields("B")
.Orientation = xlRowField
.Position = 2
End With
h3.PivotTables("Tabla dinámica2").AddDataField _
h3.PivotTables("Tabla dinámica2").PivotFields("C"), "Cuenta de C", xlCount
With h3.PivotTables("Tabla dinámica2")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
h3.PivotTables("Tabla dinámica2").PivotFields("A").Subtotals = Array( _
False, False, False, False, False, False, False, False, False, False, False, False)

u = h3.Range("N" & Rows.Count).End(xlUp).Row - 1
h3.Range("N6:P" & u).Copy
h3.Range("S1").PasteSpecial Paste:=xlPasteValues
u = h3.Range("S" & Rows.Count).End(xlUp).Row
h3.Range("S2:S" & u).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
h3.Columns("S:S").Copy
h3.Range("S1").PasteSpecial Paste:=xlPasteValues

'u2 = h3.Range("M" & Rows.Count).End(xlUp).Row
'h3.Range("N2").FormulaR1C1 = "=VLOOKUP(RC[-1],C[-4]:C[-3],2,0)"
'h3.Range("O2").FormulaR1C1 = "=SUMIF(C[-5],RC[-2],C[-3])"
'h3.Range("N2:O2").AutoFill Destination:=h3.Range("N2:O" & u2)
'Calculate
h3.Columns("S").Copy
h3.Range("B1").PasteSpecial Paste:=xlValues
h3.Columns("T").Copy
h3.Range("G1").PasteSpecial Paste:=xlValues
h3.Columns("U").Copy
h3.Range("H1").PasteSpecial Paste:=xlValues
h3.Columns("B").EntireColumn.ColumnWidth = 10.71
h3.Columns("C").EntireColumn.ColumnWidth = 10.71
h3.Columns("D").EntireColumn.ColumnWidth = 10.71
h3.Columns("E").EntireColumn.ColumnWidth = 10.71
h3.Columns("F").EntireColumn.ColumnWidth = 15.43
h3.Columns("J:U").Clear
With h3.Columns("B").Font
.Name = "Arial"
.Size = 8
End With

h2.Columns("A").VerticalAlignment = xlTop
h3.Columns("A:H").VerticalAlignment = xlTop
For n = 1 To h3.Range("B" & i & ":F" & i).Columns.Count
sngAnchoTotal = sngAnchoTotal + h3.Range("B" & i & ":F" & i).Cells(1, n).ColumnWidth
Next n
For i = 2 To h3.Range("B" & Rows.Count).End(xlUp).Row
ajustarfila h3.Range("B" & i & ":F" & i), sngAnchoTotal
Next
Application.ScreenUpdating = True
j = 14
altohoja = 1
n = 1
arr = 668.25
For i = 2 To h3.Range("B" & Rows.Count).End(xlUp).Row
j = j + 1
sigalto = h3.Rows(i + 1).Top - h3.Rows(i).Top
If h2.Cells(j, "A").Top + sigalto >= arr Then
altohoja = altohoja + 49
sig = j
Do While h2.Cells(sig, "A").Top <= arr
sig = sig + 1
Loop
With h2.Range("A" & j & ":A" & sig)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With
With h2.Range("G" & j & ":G" & sig)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With
With h2.Range("H" & j & ":H" & sig)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With
h1.Rows("45:49").Copy h2.Range("A" & sig)
h2.Rows("1:14").Copy h2.Range("A" & sig + 5)
j = sig + 5 + 14
arr = arr + 668.25 + 70.5
End If
h3.Rows(i).Copy h2.Rows(j)
With h2.Range("A" & j & ":A" & j)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With

With h2.Range("G" & j & ":G" & j)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With
With h2.Range("H" & j & ":H" & j)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With
h2.Cells(j, "A") = n
n = n + 1
Next
sig = j
Do While h2.Cells(sig, "A").Top < arr
sig = sig + 1
Loop

With h2.Range("A" & j & ":A" & sig)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With

With h2.Range("G" & j & ":G" & sig)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With
With h2.Range("H" & j & ":H" & sig)
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
End With

h1.Rows("45:49").Copy h2.Range("A" & sig)
E_SOLICITADO.Hide
h2.PrintPreview
E_SOLICITADO.Show
End Sub

Okay,  a cabo de leer mi correo y he tomado nota. Estaré al pendiente de su respuesta en este foro, gracias.  

A qué te refieres con:

Ahora tengo la necesidad de contar con una opción que me permita seleccionar solo algunos de los registros para imprimirlos

Si tienes la propiedad multiselect en el listbox, entonces puedes seleccionar uno a uno los registros que desees.

Nota: En lo sucesivo procura poner el código utilizando el icono para inserta código.

Tiene razón!,  entonces no es necesario modificar ni agregar otro botón, sin embargo, el problema para imprimir persiste, pues cuando realizo una prueba de consulta por primera vez, la macro funciona bien, sin embargo,  al intentar imprimir todos los registros por segunda ocasión o cuando intento imprimir solo uno o dos registros me aparecen esto dos errores:

Cambia esta línea:

    h3.Range("S2:S" & u).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"

Por estas líneas:

    On Error Resume Next
    h3.Range("S2:S" & u).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    On Error GoTo 0

Problema resuelto. 

Haré una nueva consulta relacionada con esta BD para la conexión y vinculación de un Excel a otro. Mientras tanto, gracias por su apoyo, que tenga un esplendido Jueves.