AW: Makkro-Neuling braucht Hilfe
18.06.2008 22:55:07
Thomas
hi franz, danke! ich habs jetzt mal so uebernommen, konnte es aber noch nicht ausprobieren weil wir heut server probleme haben. werd das makro dann morgen mal laufen lassen u sag dir dann bescheid ob es funktioniert.
ist es moeglich, den job name der in der quotelog datei mit durch das erste makro von "import new quote" in "quote log" kopiert wird, als hyperlink zu der neu erstellten datei einzufuegen?
momentan sieht der code folgendermassen aus:
Sub DataTransferToTemplateAndQuoteLogNetworkDriveTest()
Dim wbThis As Workbook, wbZiel As Workbook
Dim wksThis As Worksheet, wksZiel As Worksheet, wksListe As Worksheet
Dim strPfad As String, strProjekt As String, strDatum As String
Dim LetzteZeile As Long
Set wbThis = ThisWorkbook 'Quote Log
Set wksThis = wbThis.Worksheets("Input new Quote")
Set wksListe = wbThis.Worksheets("Quote Log")
'Path of Template and new created files
strPfad = "\\Noctf01a\DPD_Hyp\FINANCE\Tom\Template\" ' Get Template from this path
strPfad2 = "\\Noctf01a\DPD_Hyp\FINANCE\Tom\Quote Folder\" ' save quote file in this path _
later on
Set wbZiel = Workbooks.Add(Template:=strPfad & "Test_Template")
Set wksZiel = wbZiel.Worksheets("2.1. R&O LoAa") 'Transfer data to this worksheet in _
template
'Transfer following data
wksZiel.Cells(3, 4).Value = wksThis.Cells(4, 2).Value 'Job name / project name
wksZiel.Cells(10, 4).Value = wksThis.Cells(5, 2).Value 'date
wksZiel.Cells(4, 4).Value = wksThis.Cells(6, 2).Value 'Qutote nummer
wksZiel.Cells(7, 4).Value = wksThis.Cells(7, 2).Value 'Distributor
wksZiel.Cells(6, 4).Value = wksThis.Cells(8, 2).Value 'End Customer
wksZiel.Cells(3, 7).Value = wksThis.Cells(9, 2).Value 'Quote Originator
wksZiel.Cells(4, 7).Value = wksThis.Cells(10, 2).Value 'Salesperson
wksZiel.Cells(5, 7).Value = wksThis.Cells(11, 2).Value 'Originator
wksZiel.Cells(6, 7).Value = wksThis.Cells(12, 2).Value 'Marketing Manager
wksZiel.Cells(7, 7).Value = wksThis.Cells(13, 2).Value 'Region
wksZiel.Cells(13, 4).Value = wksThis.Cells(15, 2).Value 'Filename
'Save file as job name_quote#_date.xls in certain path defined above
strFilename = wksThis.Cells(11, 2).Value
wbZiel.SaveAs Filename:=strPfad2 & strFilename & ".xls"
'close file
wbZiel.Close
' Transfer data within "Quote Log" file from worksheet "input new quote" to "Quote log"
' Go into worksheet Quote Log, find the last entry, add a new row, insert the data into _
this row and adjust the sum formulas
LetzteZeile = wksListe.Range("A65500").End(xlUp).Row + 1
wksListe.Rows(LetzteZeile).Insert Shift:=xlDown ' insert new row
wksListe.Cells(LetzteZeile, 1).Value = wksThis.Cells(4, 2).Value 'transfer project name
wksListe.Cells(LetzteZeile, 2).Value = wksThis.Cells(5, 3).Value 'transfer date
wksListe.Cells(LetzteZeile, 3).Value = wksThis.Cells(6, 2).Value 'transfer Quote number
wksListe.Cells(LetzteZeile, 4).Value = wksThis.Cells(7, 2).Value 'transfer Distributor
wksListe.Cells(LetzteZeile, 5).Value = wksThis.Cells(8, 2).Value 'transfer Customer
wksListe.Cells(LetzteZeile, 6).Value = wksThis.Cells(9, 2).Value 'transfer Quote Originator
wksListe.Cells(LetzteZeile, 7).Value = wksThis.Cells(10, 2).Value 'transfer Salesperson
wksListe.Cells(LetzteZeile, 8).Value = wksThis.Cells(11, 2).Value 'transfer Originator
wksListe.Cells(LetzteZeile, 9).Value = wksThis.Cells(12, 2).Value 'transfer Marketing _
Manager
wksListe.Cells(LetzteZeile, 10).Value = wksThis.Cells(13, 2).Value 'transfer Region
wksListe.Cells(LetzteZeile, 34).Value = wksThis.Cells(15, 2).Value 'transfer Filename
'adjust formulas
wksListe.Cells(LetzteZeile + 1, 11).Formula = "=SUM(K2:K" & LetzteZeile & ")" 'adjust sum _
formula EABU sale
wksListe.Cells(LetzteZeile + 1, 12).Formula = "=SUM(L2:L" & LetzteZeile & ")" 'adjust sum _
formula LVSG
wksListe.Cells(LetzteZeile + 1, 13).Formula = "=SUM(M2:M" & LetzteZeile & ")" 'adjust sum _
formula Busway
wksListe.Cells(LetzteZeile + 1, 14).Formula = "=SUM(N2:N" & LetzteZeile & ")" 'adjust sum _
formula MCC
wksListe.Cells(LetzteZeile + 1, 15).Formula = "=SUM(O2:O" & LetzteZeile & ")" 'adjust sum _
formula PBSB
wksListe.Cells(LetzteZeile + 1, 16).Formula = "=SUM(P2:P" & LetzteZeile & ")" 'adjust sum _
formula LP
wksListe.Cells(LetzteZeile + 1, 17).Formula = "=SUM(Q2:Q" & LetzteZeile & ")" 'adjust sum _
formula Buyout total
wksListe.Cells(LetzteZeile + 1, 18).Formula = "=SUM(R2:R" & LetzteZeile & ")" 'adjust sum _
formula Buyout IIPMO
wksListe.Cells(LetzteZeile + 1, 19).Formula = "=SUM(S2:S" & LetzteZeile & ")" 'adjust sum _
formula Bayout Regular
wksListe.Cells(LetzteZeile + 1, 21).Formula = "=SUM(U2:U" & LetzteZeile & ")" 'adjust sum _
formula EBIT
'set frame for new row
Sheets("Quote Log").Select
Cells(LetzteZeile, 1).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End Sub
was muesste dafuer geaendert werden?
tausend dank und gruesse
tom