[es] - excel vba code pomoc

mirjanagb
mirjana kovacevic
austrija

Član broj: 160826
Poruke: 184
*.bankgutmann.co.at.

+1 Profil

^{25.02.2009. u 13:17 - pre 184 meseci}

radi se o sledecem:

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:

Code:
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:

Code:

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.

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2268
194.106.167.*

Sajt: www.gowi.rs

+109 Profil

Re: excel vba code pomoc

^{01.03.2009. u 17:17 - pre 184 meseci}

Iako si postavila puno koda, bez poznavanja strukture radne sveske teško mogu da tačno znam o čemu se radi. U kodu nema nikakvih objašnjenja a i nemački nazivi promenljivih mi ne pomažu previše. U svakom slučaju verovatno si u pravu da je potrebno izmeniti petlju:

Code:
Do While Worksheets("PB-Liste").Cells(Zeile, 2).Value <> "" ... Loop

Unutar ove petlje kreira se direktorijum u koji se smešta PDF fajl i kreira se pdf fajl pomoću rutine PrintToPDF_Early. Ovaj deo može bez problema da ostane ali je potrebno formirati ime i putanju u koji se smešta pdf fajl. Rutina za štampu jednostavno štampa aktivni list kao pdf, pa je koliko ja shvatam potrebno samo formirati petlju koja će aktivirati određeni radni list pre poziva ove rutina. Ne znam koje radne listove treba aktivirati, ali pošto spominješ da se "ide po listi", pretpostavljam da imaš imenovanu listu recimo "Test" u kojoj se nalaze nazivi listova koje treba štampati. To je moguće uraditi na različite načine, ja bih lično koristio For Each ... Next petlju

Code:

Sub StampanjeListovaPoSpisku()
'
' Poziva se rutina za stampu lista
' na osnovu spiska listova za stampu u imenovanom opsegu Test
'
Dim cl As Range

For Each cl In Range("Test")
    Sheets(cl.Text).Activate
    ' Ovde ubaciti formiranje naziva i poziv rutine za stampu
    '
Next cl
End Sub

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu

mirjanagb
mirjana kovacevic
austrija

Član broj: 160826
Poruke: 184
*.bankgutmann.co.at.

+1 Profil

Re: excel vba code pomoc

^{13.03.2009. u 14:57 - pre 184 meseci}

napisala sam ... uglavnom mala reorganizacija ovog selektovanog dela...

ali sad imam jedno drugo pitanje ... ako hocu da snimim kao pdf 3 sheets, kako da napisem kod za to?

Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2268
136.148.127.*

Sajt: www.gowi.rs

+109 Profil

Re: excel vba code pomoc

^{13.03.2009. u 15:27 - pre 184 meseci}

Da li treba u jedan pdf da "odštampaš" tri lista?

Za štampanje koristiš specifičnu biblioteku koja nije standardni deo Excela pa ne mogu da budem siguran.
Ja bi pokušao da selektujem tri lista i onda ih prosledim komandi print out u proceduri PrintToPDF_Early.
Dakle probaj da zameniš red

Code:
ActiveSheet.PrintOut Copies:=1 ActivePrinter:="PDFCreator"

Sa sledećim kodom:

Code:

' Remove Multiple Selections
ActiveWorkbook.Sheets(1).Select

' Select Multiple Sheets
' Optional False is to extend the current selection to include any previously selected objects
ActiveWorkbook.Sheets(1).Select False
ActiveWorkbook.Sheets(2).Select False
ActiveWorkbook.Sheets(3).Select False

ActiveWindow.SelectedSheets.PrintOut Copies:=1 ActivePrinter:="PDFCreator"

' Remove Multiple Selections
ActiveWorkbook.Sheets(1).Select

End Sub

Nije to loše Rembrante, samo što ne bi dodao još malo boje?

Odgovor na temu