< návrat zpět
MS Excel
Téma: Export do PDF souboru 
Zaslal/a Johan-Kraczmar 4.6.2015 12:30
Zdravím ,
Potřeboval bych změnit trochu makro, aby se mi to neukládalo jako další list, ale aby se to vyexportovalo jako PDF se jménem jak je uvedeno v kódu do adresáře \\Pracovni\2015
Jde o zvýrazněnou část, všechno ostatní zůstává stejné.
Moc prosím
Dim r As Long, Z As Range
Dim posl As Integer, N As String
If MsgBox("JSOU ZADANÉ ÚDAJE V POŘÁDKU ?", vbYesNo, "Odeslání do databáze") = vbYes Then ' okno z upozorněním o vyčištění formuláře
Set Z = Sheets("Databáze").Range("A2:E2") 'První záznam v DB
With Z
On Error Resume Next 'První volný řádek
r = .Resize(Sheets("Databáze").Range("A:A").Rows.Count - .Row + 1).Cells.Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues).Row - .Row + 1
On Error GoTo 0
' 1. Poslední záznam jako poslední v DB -------------------------------------
'Z.Offset(r, 0).Value = Sheets("Formulář").Range("B4:F4").Value
' -----------------------------------------------------------------
' 2. Poslední záznam na jako první v DB -------------------------------------
.Resize(r + 1 - IIf(r > 0, 1, 0), .Columns.Count).Offset(1, 0).Value = .Resize(r + 1 - IIf(r > 0, 1, 0), .Columns.Count).Value 'Posun o řádek dolů
.Value = Sheets("Datový list").Range("A26:E26").Value 'Poslední zápis na první řádek DB
End With
With ThisWorkbook 'Pro tento sešit
.Worksheets("Protokol").Copy after:=.Worksheets("Databáze") 'Kopíruj list Protokol
With .Worksheets("Datový list")
N = .Range("A26") & " " & .Range("C26") 'Název pro nový list
End With
With .Worksheets(.Worksheets("Databáze").Index + 1) 'Pro novou kopii
.Name = N 'Nastav název
.Buttons("btnOdeslatUlozit").Delete 'vymaž zkopírované tlačítko
.Range("B2:M44").Validation.Delete 'vymaže seznamy
End With
.Save
End With
Worksheets("Protokol").Activate
Range("D28,D29,D30,K5,B5,B8,C8,D8,G8,L8,B10,F11,F15,H15,L15,F16,H16,L16,F17,H17,L17,F18,H18,L18,F21,H21,L21,F22,H22,L22,F25,H25,L25,F28,H28,L28,F29,H29,L29,F30,H30,L30,B33,F40,H40,L40").Select ' vybere zadanou oblast buněk
Selection.ClearContents ' vymaže data
ThisWorkbook.Save ' uloží
End If
End Sub
With ThisWorkbook 'Pro tento sešit
With .Worksheets("Datový list")
N = .Range("A26") & " " & .Range("C26") 'Název pro nový list
End With
Cesta = .Path & "\"
With .Worksheets("Protokol")
.Buttons("btnOdeslatUlozit").Visible = False 'Skryť tlačítko
On Error Resume Next
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Cesta & N, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
If Err <> 0 Then
MsgBox ("Chyba při exportu do" & vbNewLine & Cesta & N)
Err.Clear
End If
On Error GoTo 0
.Buttons("btnOdeslatUlozit").Visible = True 'Zobraziť tlačítko
End With
End Withcitovat
\n
RSS nejnovější články