Hips!
Pitäisi saada taul1 tallennettua päivämäärällä nimellä mikä haetaan soluista B13 ja B14 . Lopputulos olisi pvmnumeronimi.xls ja samaan kansioon mistä avattu.
Olisi hyvä jos saisi esim Taul4 riviyhteenvedon A1=pvm B1=numero C1=nimi joka vielä toimisi linnkinä tallennettuun asiakirjaan.
Olipas sekava, onko edes mahdollista??
Pitäisi saada taul1 tallennettua päivämäärällä nimellä mikä haetaan soluista B13 ja B14 . Lopputulos olisi pvmnumeronimi.xls ja samaan kansioon mistä avattu.
Olisi hyvä jos saisi esim Taul4 riviyhteenvedon A1=pvm B1=numero C1=nimi joka vielä toimisi linnkinä tallennettuun asiakirjaan.
Olipas sekava, onko edes mahdollista??
Vastaukset 10
Vanhimmat
Tämä ei toimi!
Sub Tallenna_nimellä()
Sheets("Laskutus").Select
Dim SoluB14 As String
SoluA10 = Range("B14")
On Error GoTo Virhe
ChDir "E:\JRPC"
ActiveWorkbook.SaveAs Filename:= _
"E:\JRPC" & "SoluB14.xls", FileFormat:=xlNormal
GoTo Loppu
Virhe:
MsgBox ("Tallennus ei onnistunut")
Loppu:
End Sub
ainakin tämä rivi: "E:\JRPC" & "SoluB14.xls", FileFormat:=xlNormal
olisi toimiva näin: "E:\JRPC" & SoluB14 & ".xls", FileFormat:=xlNormal
Tämä
Sub Tallenna_nimellä()
Sheets("Laskutus").Select
Dim B14 As String
B14 = Range("B14")
On Error GoTo Virhe
ChDir "E:\JRPC"
ActiveWorkbook.SaveAs Filename:= _
"E:\JRPC" & SoluB14 & ".xls", FileFormat:=xlNormal
GoTo Loppu
Virhe:
MsgBox ("Tallennus ei onnistunut")
Loppu:
End Sub
talentaa työkirjan nimellä JRPC e: juureen.
Pitäisi saada Kansioon E:\JRPC nimellä solusta B14
"Olisi hyvä jos saisi esim Taul4 riviyhteenvedon A1=pvm B1=numero C1=nimi joka vielä toimisi linnkinä tallennettuun asiakirjaan."
Mistäs toi numero tulee?
tossa nyt ilman numeroa toimiva versio
taulukoiden nimet oletuksilla Taul1-4
:-)
moduuliin...
Sub Tallenna()
Dim Polku As String
Dim vika As Integer
On Error GoTo virhe
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Taul1").Activate
Polku = ThisWorkbook.Path & "\" & Range("B13") & Range("B14") & ".xls"
Sheets("Taul4").Range("A1") = Range("B13")
Sheets("Taul4").Range("C1") = Polku
Sheets("Taul4").Columns("A:C").AutoFit
Cells.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=Polku
Range("A1").Select
ActiveWindow.Close
Range("A1").Select
Sheets("Taul4").Select
vika = Range("A65336").End(xlUp).Row 1
Range("A" & vika) = Sheets("Taul1").Range("B13")
Range("C" & vika) = Polku
ActiveSheet.Hyperlinks.Add Anchor:=Range("C" & vika), Address:=Linkki
virhe:
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
ja Taul4 moduuliin...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Range("C:C"), Target) Is Nothing Then
If Target = "" Then Exit Sub
ThisWorkbook.FollowHyperlink Address:=Target
End If
End Sub
Numero tulee solusta F3
Nimi solusta B14
nuo tiedot haetaan toisesta taulukosta.
Sheets("Taul4").Range("A1") = Range("B13")
Sheets("Taul4").Range("C1") = Polku
muuta
Sheets("Taul4").Range("A1") = Range("B13")
Sheets("Taul4").Range("B1") = Range("F3")
Sheets("Taul4").Range("C1") = Polku
Laittaa koko koodin uudestaan, sait minut vaan sekaisin noilla korjauksilla. :=)
Sub Tallenna()
Dim Polku As String
Dim vika As Integer
On Error GoTo virhe
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Taul1").Activate
Polku = ThisWorkbook.Path & "\" & Range("B13") & Range("B14") & ".xls"
Sheets("Taul4").Range("A1") = Range("B13")
Sheets("Taul4").Range("B1") = Range("F3")
Sheets("Taul4").Range("C1") = Polku
Sheets("Taul4").Columns("A:C").AutoFit
Cells.Copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
ActiveWorkbook.SaveAs Filename:=Polku
Range("A1").Select
ActiveWindow.Close
Range("A1").Select
Sheets("Taul4").Select
vika = Range("A65336").End(xlUp).Row 1
Range("A" & vika) = Sheets("Taul1").Range("B13")
Range("C" & vika) = Polku
ActiveSheet.Hyperlinks.Add Anchor:=Range("C" & vika), Address:=Linkki
virhe:
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
ja Taul4 moduuliin...
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Application.Intersect(Range("C:C"), Target) Is Nothing Then
If Target = "" Then Exit Sub
ThisWorkbook.FollowHyperlink Address:=Target
End If
End Sub
Tämä toimii hienosti, tosin taisin selittää huonosti alussa. tarkoitus että talennukset menevät Taul4 joka kerta uudelle riville.
Kiitos
Toimii sittenkin oli typo virhe :)