treba da napisem jedan makro za snimanje fajlova kao pdf.
to je jedan excel fajl u kome se racunaju:
aj da kazem: pdf fajl za klijente i pdf fajl za fondove.
ja vec imam napisan makro za snimanje pdf- za klijente i treba da napisem za fondove.
problem je u tome sto ima razlike u listanju i racunanju. excel je veliki i sve je povezano, atko da tesko mogu da postavim, ali kod mogu:
Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal Pfad As String) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMS As Long)
'Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim objComment
On Error Resume Next
Set objComment = Target.Cells(1, 1).Comment
If Not objComment Is Nothing Then
If InStr(1, objComment.Text, "Series") > 0 And InStr(1, objComment.Text, "Class") > 0 Then
CommandBars("EwShort").ShowPopup
Cancel = True
Else
Cancel = False
End If
End If
End Sub
Sub Drucken_Manager()
Dim sPath As String
Dim Betreuer As String
Dim Depot As String
Dim spezialNummer As Integer
Dim masterPath As String
Dim perDatPath As String
Dim perDat As String
spezialNummer = 149
Zeile = 149
ZeileKunde = 150
masterPath = "MK"
Worksheets("Auswahl").Range("V8").Value = spezialNummer
Do While Worksheets("PB-Liste").Cells(Zeile, 2).Value <> ""
If Worksheets("PB-Liste").Cells(Zeile, 5).Value <> "" Then
Betreuer = Worksheets("PB-Liste").Cells(Zeile, 4).Value
Depot = Worksheets("PB-Liste").Cells(Zeile, 5).Value
Worksheets("Liste").Cells(ZeileKunde, 9).Value = Zeile - 148
perDat = Worksheets("Kunden").Range("L30").Value
perDatPath = mk_bp_date(perDat)
Call ChartKunden
sPath = masterPath & Betreuer & "\" & perDatPath & "\"
If Dir(sPath, vbDirectory) = "" Then
Call MakeDir(sPath)
Else
'MsgBox "Verzeichnis " & sPath & " Existiert schon"
'Exit Sub
End If
Call PrintToPDF_Early(sPath, Depot)
Zeile = Zeile + 1
Else
Zeile = Zeile + 1
End If
Loop
End Sub
Sub PrintToPDF_Early(sPDFPATH As String, sPDFName As String)
'Author : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from http://sourceforge.net/projects/pdfcreator/)
' Designed for early bind, set reference to PDFCreator
Dim pdfjob As PDFCreator.clsPDFCreator
'Check if worksheet is empty and exit if so
If IsEmpty(ActiveSheet.UsedRange) Then Exit Sub
Set pdfjob = New PDFCreator.clsPDFCreator
With pdfjob
If .cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPATH
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Print the document to PDF
ActiveSheet.PrintOut Copies:=1, ActivePrinter:="PDFCreator"
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Sleep 250
Loop
pdfjob.cClose
Set pdfjob = Nothing
End Sub
Sub ChartKunden()
Worksheets("Kunden").Select
P = Cells(16, 18).Value
q = Cells(17, 18).Value
s = Cells(17, 19).Value
ActiveSheet.ChartObjects("Chart 12").Activate
ActiveChart.Axes(xlValue).Select
On Error Resume Next
With ActiveChart.Axes(xlValue)
.MinimumScale = P
.MaximumScale = q
.MajorUnit = s
End With
Range("O19").Select
End Sub
Sub MakeDir(directory As String)
On Error Resume Next
MkDir directory
End Sub
Function mk_bp_date(dat)
Jahr = Year(dat)
Monat = two_dig(Month(dat))
Tag = two_dig(Day(dat))
mk_bp_date = Jahr & Monat & Tag
End Function
Function two_dig(num)
If num < 10 Then
two_dig = "0" & num
Else
two_dig = "" & num
End If
End Function
ono sto pretpostavljam jeste da se samo ovo mora promeniti:
Sub Drucken_Manager()
Dim sPath As String
Dim Betreuer As String
Dim Depot As String
Dim spezialNummer As Integer
Dim masterPath As String
Dim perDatPath As String
Dim perDat As String
spezialNummer = 149
Zeile = 149
ZeileKunde = 150
masterPath = "MK"
Worksheets("Auswahl").Range("V8").Value = spezialNummer
Do While Worksheets("PB-Liste").Cells(Zeile, 2).Value <> ""
If Worksheets("PB-Liste").Cells(Zeile, 5).Value <> "" Then
Betreuer = Worksheets("PB-Liste").Cells(Zeile, 4).Value
Depot = Worksheets("PB-Liste").Cells(Zeile, 5).Value
Worksheets("Liste").Cells(ZeileKunde, 9).Value = Zeile - 148
perDat = Worksheets("Kunden").Range("L30").Value
perDatPath = mk_bp_date(perDat)
Call ChartKunden
sPath = masterPath & Betreuer & "\" & perDatPath & "\"
radi se o tome da za klijente imam u jednom excel sheet-u listu sa nazivima menadzera i koliko imaju klijetana (PB-Liste)
u sheet Liste je samo u jedom redu napisano ime menadzera i pomocu formule OFFSET se menjaju nazivi
sheet auswal i kunden moze ostati i za fondove.
e sad za fondove imam samo u sheet Liste listu fondova bez formule OFFSET.
pretpostavljam da se samo ovaj deo menja da bi se snimilo pdf za fondove.
kako da napisem vba code znaci da ne trazi ovaj spezialnummer vec da ide samo po listi.