18. februar 2006 - 16:00Der er
38 kommentarer og 1 løsning
VBA: Udskriv og gem på server.
Hej drenge og piger.
Jeg har på mit arbejde et excel ark som bruges til indrapportering af produktion for hvert holdskifte.
Det jeg søger er:
1: At efter udskrift (ctrl + p) eller "udskriv" via menuen, at en makro opfanger det, og bagefter automatisk gemmer filen på serveren et bestemt sted + bestemt filnavn udfra kriterier.
eller
2: Hvis ikke det kan lade sig gøre med ovenstående, så lave en funktion der "overruler" den alm "Gem" funktion i excel, og så gemmer den et bestemt sted på serveren som beskrevet ovenover.
Kriterierne, if,then,else løkker kan jeg sagtens selv klare, men selve "Gem" delen er jeg ike så skarp til.
Kan dette lade sig gøre ?
I kan til eks. bruge følgende streng til "Gem" stien.
Jeg er ikke vant til VBA i excel, har udelukkende brugt VBscript i forbindelse med ASP.
kan du finde nogen fejl i denne her ?
If Sheets("QF25").[L2].Text = "1" Then strShift = "\HOLD_1\" ElseIf Sheets("QF25").[L2].Text = "2" Then strShift = "\HOLD_2\" ElseIf Sheets("QF25").[L2].Text = "3" Then strShift = "\HOLD_3\" End If
Select Case Sheets("QF25").[L2].Text Case "1" strShift = "\HOLD_1\" Case "2" strShift = "\HOLD_2\" Case "3" strShift = "\HOLD_3\" Case Else MsgBox " ingen valgt" Exit Sub End Select
christ... nu gir den mig en fejl 400.. Selvom jeg har oprettet alle biblioteker på mit drev.
lad mig prøve at paste hele min save del her..
--------------------- Sub FileSave()
Dim strSrv As String Dim strLine As String Dim strShift As String Dim strYear As String Dim strMonth As String Dim strDate As String Dim strSaveQF25 As String
'sti til QF25 på serveren strSrv = "C:\Test"
' Hvilken Linie køres der på Select Case Sheets("QF25").[G2].Text Case "40" strLine = "\40" Case "36" strLine = "\36" Case Else MsgBox Sheets("QF25").[G2].Text Exit Sub End Select
' Hvilket skiftehold arbejdes på Select Case Sheets("QF25").[L2].Text Case "1" strShift = "\HOLD_1" Case "2" strShift = "\HOLD_2" Case "3" strShift = "\HOLD_3" Case Else MsgBox Sheets("QF25").[L2].Text Exit Sub End Select
' Henter årstallet ud fra datoen ex. 20060218 strYear = "\" & Left(Sheets("QF25").[R2].Text, 4)
' Henter måneden ud fra datoen strMonth = "\" & Mid(Sheets("QF25").[R2].Text, 4, 2)
Hvis du kan hjælpe mig med det her så ville det være genialt.
Er der iøvrigt en måde, hvorpå den ikke melder fejl hvis biblioteket ikke eksisterer, men bare opretter det selv ? Hvis det er alt for krævende så er det ligemeget, ellers kan vi selv oprette dem manuelt på serveren. :)
>> Jeg har cellen R2 som indeholder datoen idag formateret åååmmdd (20060218)
Det er forhåbentlig en datoværdi, som bare er formateret sådan, hvis det kun er tal, går det galt
Synes godt om
Slettet bruger
18. februar 2006 - 18:24#15
Til første spørgsmål: Kan man ikke "bare" lave en makro, der udskriver og gemmer arket? Evt med en knap? Jeg har aldrig taget mig tid til at lære vba ordentligt, men har et hav af finurlige makros.
kabbak >>> Jeg tænkte det måske også kunne være det... R2 indeholder en henvisning til en anden celle med datoen formateret som dato. men R2 er med Brugerdefineret formatering(åååmmdd) ... selvom jeg prøvede at sætte den til P2 som indeholder datoen 18-02-2006 ...
hans-jensen >> Meningen med galskaben er, at der ikke skal være nogle knapper. Med min sub der overruler den excels almindelige "Gem" funktion ved Ctrl+s og bruger min sub i stedet. Dog kunne jeg rigtig godt tænke mig at få deaktiveret "Gem" funktionen i menuen "filer" HELT, så jeg er sikker på der ikke gemmes udenom min funktion.
Dim strSrv As String Dim strLine As String Dim strShift As String Dim strYear As String Dim strMonth As String Dim strDate As String Dim strSaveQF25 As String
'sti til QF25 på serveren strSrv = "C:\Test"
' Hvilken Linie køres der på Select Case Sheets("QF25").[G2].Text Case "40" strLine = "\40" Case "36" strLine = "\36" Case Else MsgBox Sheets("QF25").[G2].Text Exit Sub End Select
' Hvilket skiftehold arbejdes på Select Case Sheets("QF25").[L2].Text Case "1" strShift = "\HOLD_1" Case "2" strShift = "\HOLD_2" Case "3" strShift = "\HOLD_3" Case Else MsgBox Sheets("QF25").[L2].Text Exit Sub End Select
' Henter årstallet ud fra datoen ex. 20060218 strYear = "\" & Year(Sheets("QF25").[R2].Value)
' Henter måneden ud fra datoen strMonth = "\" & Month(Sheets("QF25").[R2].Value)
Dim strSrv As String Dim strLine As String Dim strShift As String Dim strYear As String Dim strMonth As String Dim strDate As String Dim strSaveQF25 As String Dim strDirQF25 As String Dim StiTjek As String
'sti til QF25 på serveren strSrv = "C:\Test"
' Hvilken Linie køres der på Select Case Sheets("QF25").[G2].Text Case "40" strLine = "\40" Case "36" strLine = "\36" Case Else MsgBox Sheets("QF25").[G2].Text Exit Sub End Select
' Hvilket skiftehold arbejdes på Select Case Sheets("QF25").[L2].Text Case "1" strShift = "\HOLD_1" Case "2" strShift = "\HOLD_2" Case "3" strShift = "\HOLD_3" Case Else MsgBox Sheets("QF25").[L2].Text Exit Sub End Select
' Henter årstallet ud fra datoen ex. 20060218 strYear = "\" & Year(Sheets("QF25").[R2].Value)
' Henter måneden ud fra datoen strMonth = "\" & Month(Sheets("QF25").[R2].Value)
strDirQF25 = strSrv & strLine & strYear & strMonth & strShift ' stien hentes ind i en variabel StiTjek = Dir(strDirQF25, vbDirectory) ' stien tjekkes om den er der If StiTjek = "" Then MkDir strDirQF25 ' hvis ikke laves den End If
' Her gemmes dokumentet på serveren udfra vores ' forespørgsler på linie, hold og dato. strSaveQF25 = strSrv & strLine & strYear & strMonth & strShift & strDate & ".xls" ThisWorkbook.SaveAs strSaveQF25
Dim strSrv As String Dim strLine As String Dim strShift As String Dim strYear As String Dim strMonth As String Dim strDate As String Dim strSaveQF25 As String Dim strDirQF25 As String Dim StiTjek As String
'sti til QF25 på serveren strSrv = "C:\Test"
' Hvilken Linie køres der på Select Case Sheets("QF25").[G2].Text Case "40" strLine = "\40" Case "36" strLine = "\36" Case Else MsgBox Sheets("QF25").[G2].Text Exit Sub End Select
' Hvilket skiftehold arbejdes på Select Case Sheets("QF25").[L2].Text Case "1" strShift = "\HOLD_1" Case "2" strShift = "\HOLD_2" Case "3" strShift = "\HOLD_3" Case Else MsgBox Sheets("QF25").[L2].Text Exit Sub End Select
StiTjek = Dir(strDirQF25, vbDirectory) ' stien tjekkes om den er der ' Henter årstallet ud fra datoen ex. 20060218 strYear = "\" & Year(Sheets("QF25").[R2].Value)
' Henter måneden ud fra datoen strMonth = "\" & Month(Sheets("QF25").[R2].Value)
' Her gemmes dokumentet på serveren udfra vores ' forespørgsler på linie, hold og dato. strSaveQF25 = strSrv & strLine & strYear & strMonth & strShift & strDate & ".xls" ThisWorkbook.SaveAs strSaveQF25
End Sub
Public Sub LavSti(Sti) Dim StiTjek As String StiTjek = Dir(Sti, vbDirectory) ' stien tjekkes om den er der If StiTjek = "" Then MkDir Sti ' hvis ikke laves den End If End Sub
Dim strSrv As String Dim strLine As String Dim strShift As String Dim strYear As String Dim strMonth As String Dim strDate As String Dim strSaveQF25 As String Dim strDirQF25 As String Dim StiTjek As String
'sti til QF25 på serveren strSrv = "C:\Test"
' Hvilken Linie køres der på Select Case Sheets("QF25").[G2].Text Case "40" strLine = "\40" Case "36" strLine = "\36" Case Else MsgBox Sheets("QF25").[G2].Text Exit Sub End Select
' Hvilket skiftehold arbejdes på Select Case Sheets("QF25").[L2].Text Case "1" strShift = "\HOLD_1" Case "2" strShift = "\HOLD_2" Case "3" strShift = "\HOLD_3" Case Else MsgBox Sheets("QF25").[L2].Text Exit Sub End Select
StiTjek = Dir(strDirQF25, vbDirectory) ' stien tjekkes om den er der ' Henter årstallet ud fra datoen ex. 20060218 strYear = "\" & Year(Sheets("QF25").[R2].Value)
' Her gemmes dokumentet på serveren udfra vores ' forespørgsler på linie, hold og dato. strSaveQF25 = strSrv & strLine & strYear & strMonth & strShift & strDate & ".xls" ThisWorkbook.SaveAs strSaveQF25
End Sub
Public Sub LavSti(Sti) Dim StiTjek As String StiTjek = Dir(Sti, vbDirectory) ' stien tjekkes om den er der If StiTjek = "" Then MkDir Sti ' hvis ikke laves den End If End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) FileSave Cancel = True End Sub
og den anden ser sådan ud, læg mærke til hvad der står på begge sider af gem linien
Når du har sat det ind kan den kun gemmes over din kode
Sub FileSave()
Dim strSrv As String Dim strLine As String Dim strShift As String Dim strYear As String Dim strMonth As String Dim strDate As String Dim strSaveQF25 As String Dim strDirQF25 As String Dim StiTjek As String
'sti til QF25 på serveren strSrv = "C:\Test"
' Hvilken Linie køres der på Select Case Sheets("QF25").[G2].Text Case "40" strLine = "\40" Case "36" strLine = "\36" Case Else MsgBox Sheets("QF25").[G2].Text Exit Sub End Select
' Hvilket skiftehold arbejdes på Select Case Sheets("QF25").[L2].Text Case "1" strShift = "\HOLD_1" Case "2" strShift = "\HOLD_2" Case "3" strShift = "\HOLD_3" Case Else MsgBox Sheets("QF25").[L2].Text Exit Sub End Select
StiTjek = Dir(strDirQF25, vbDirectory) ' stien tjekkes om den er der ' Henter årstallet ud fra datoen ex. 20060218 strYear = "\" & Year(Sheets("QF25").[R2].Value)
' Her gemmes dokumentet på serveren udfra vores ' forespørgsler på linie, hold og dato. strSaveQF25 = strSrv & strLine & strYear & strMonth & strShift & strDate & ".xls" Application.EnableEvents = False ThisWorkbook.SaveAs strSaveQF25 Application.EnableEvents = True End Sub
Public Sub LavSti(Sti) Dim StiTjek As String StiTjek = Dir(Sti, vbDirectory) ' stien tjekkes om den er der If StiTjek = "" Then MkDir Sti ' hvis ikke laves den End If End Sub
Dim strDirQF25 As String Dim StiTjek As String StiTjek = Dir(strDirQF25, vbDirectory) ' stien tjekkes om den er der
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
