Haluaisin Excelin tallentavan avatun työkirjan automaattisesti ja nimeävän sen määrätyn solun ja juoksevan numeron mukaan. (esim työkirja 1, työkirja 2 jne.)
Kiitos.
Tallenna+juokseva numero
AnnaKaisa
7
5560
Vastaukset
- remec
Tossa vaikka tommonen viritys, saat sen toimiin ku teet "taul2" laskentataulukkoon juoksevan numeroinnin , eli a1 = 1 a2 = 2 ..... a10000 =10000. nythän se käy hakemassa nimen tiedostolle laskentataulukon "taul1" a1 solusta
ja juoksevan numeron "taul2" taulukon a1- a65000 soluista, ts. sieltä asti kun olet juoksevaa numerointia sinne määritellyt.
Sub Makro2()
Sheets("Taul2").Select
Rows("1:1").Select
Selection.Delete Shift:=xlUp
tieto = Range("a1")
Sheets("Taul1").Select
ActiveWorkbook.SaveAs Filename:= _
"C:\" & Range("a1") & tieto & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
End Sub
aika purkka viritys eikö =)- noviisi
Tervehdys!
Miten tuon virityksen saisi toimimaan lisäksi niin, että kyseinen juokseva numero siirtyy myös tiettyyn soluun. Esim. Taul1:n A1? - Kunde
noviisi kirjoitti:
Tervehdys!
Miten tuon virityksen saisi toimimaan lisäksi niin, että kyseinen juokseva numero siirtyy myös tiettyyn soluun. Esim. Taul1:n A1?vähän fiksummin...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Numero As String
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
Numero = HaeNumero(Range("A1"))
ActiveWorkbook.SaveAs Filename:="C:\" & Range("a1") & ".xls"
Range("A1") = "työkirja " & (Numero 1)
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End Sub
Function HaeNumero(Teksti As String)
Dim i As Integer
Dim sana As String
i = 1
Do Until sana Like (" *")
sana = Right(Teksti, i)
i = i 1
Loop
HaeNumero = Trim(sana)
End Function - noviisi
Kunde kirjoitti:
vähän fiksummin...
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Numero As String
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
Numero = HaeNumero(Range("A1"))
ActiveWorkbook.SaveAs Filename:="C:\" & Range("a1") & ".xls"
Range("A1") = "työkirja " & (Numero 1)
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End Sub
Function HaeNumero(Teksti As String)
Dim i As Integer
Dim sana As String
i = 1
Do Until sana Like (" *")
sana = Right(Teksti, i)
i = i 1
Loop
HaeNumero = Trim(sana)
End FunctionVoisinko vielä sen verran vaivata, että en osannut ottaa tuota Kunden systeemiä käyttöön...
Makroilla sain edellisen ohjeen mukaan tehtyä, mutta tätä en saanut toimimaan.
Eli minne tuo teksti pitää kopioida ja pitäisikö se pystyä liittämään toimintopainikkeeseen?
Olen tehnyt siis laskupohjan, jossa solussa B4 on laskunumero. Tuo laskunumero pitäisi saada siis juoksevaksi ja automaattisesti vaihtuvaksi (tallennettaessa). Tallennus ja tulostus tapahtuu makroon liitetyllä painikkeella. - Kunde
noviisi kirjoitti:
Voisinko vielä sen verran vaivata, että en osannut ottaa tuota Kunden systeemiä käyttöön...
Makroilla sain edellisen ohjeen mukaan tehtyä, mutta tätä en saanut toimimaan.
Eli minne tuo teksti pitää kopioida ja pitäisikö se pystyä liittämään toimintopainikkeeseen?
Olen tehnyt siis laskupohjan, jossa solussa B4 on laskunumero. Tuo laskunumero pitäisi saada siis juoksevaksi ja automaattisesti vaihtuvaksi (tallennettaessa). Tallennus ja tulostus tapahtuu makroon liitetyllä painikkeella.itselle aina niin itsestäänselvyys noi moduulit, että unohtuu mainita. Joten kopioi koodi ThisWorkook moduuliin. Et tarvitse mitään erillistä makronappulaa. Toimii ihan normaaleilla tallennusjutuilla. Nyt siis hakee A1 solusta nimen esim. työkirja 1 (pitää olla väli) ja tallentaa ja muuttaa A1 arvoksi työkirja 2 jne...
muuta A1--->> B4 niin toimii.
Jos haluat vain pelkästään numerolla tallentaa B4 mukaan niin
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
ActiveWorkbook.SaveAs Filename:="C:\" & Range("B4")& ".xls"
Range("B4") = Range("B4") 1
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End Sub - noviisi
Kunde kirjoitti:
itselle aina niin itsestäänselvyys noi moduulit, että unohtuu mainita. Joten kopioi koodi ThisWorkook moduuliin. Et tarvitse mitään erillistä makronappulaa. Toimii ihan normaaleilla tallennusjutuilla. Nyt siis hakee A1 solusta nimen esim. työkirja 1 (pitää olla väli) ja tallentaa ja muuttaa A1 arvoksi työkirja 2 jne...
muuta A1--->> B4 niin toimii.
Jos haluat vain pelkästään numerolla tallentaa B4 mukaan niin
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
ActiveWorkbook.SaveAs Filename:="C:\" & Range("B4")& ".xls"
Range("B4") = Range("B4") 1
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End SubUpeeta hei!
On se hienoa, että täältä löytyy asian osaavia ja aina vielä valmiina auttamaan. Suuret kiitokset sinulle Kunde, nyt se toimii. :-) - Bakayaro
Kunde kirjoitti:
itselle aina niin itsestäänselvyys noi moduulit, että unohtuu mainita. Joten kopioi koodi ThisWorkook moduuliin. Et tarvitse mitään erillistä makronappulaa. Toimii ihan normaaleilla tallennusjutuilla. Nyt siis hakee A1 solusta nimen esim. työkirja 1 (pitää olla väli) ja tallentaa ja muuttaa A1 arvoksi työkirja 2 jne...
muuta A1--->> B4 niin toimii.
Jos haluat vain pelkästään numerolla tallentaa B4 mukaan niin
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo virhe
Application.EnableEvents = False
Cancel = True
ActiveWorkbook.SaveAs Filename:="C:\" & Range("B4")& ".xls"
Range("B4") = Range("B4") 1
poistu:
Application.EnableEvents = True
Exit Sub
virhe:
Resume poistu
End SubEli itsellä olisi semmonen ongelma, että tarvis saada pohja, joka muistaa ohjelman sammutamisen jälkeen, mikä oli viimesen tiedoston numero.
Toisin sanoen pohja olisi taas "tyhjä", mutta työkirjan numero olisi se mihin jäätiin.
Tällä VBE ohjeella sain omanikin toimiin muuten, mutta se ei muista sitä viimesintä tiedoston numeroa, joten tästä ei silleen ole apua näin.
Mutta suuri kiitos, jos joku VBE tms. taitoinen pyöräyttäisi semmosen pätkän scriptiä vielä, joka saisi tuon "muistamisen" aikaan.
Ketjusta on poistettu 0 sääntöjenvastaista viestiä.
Luetuimmat keskustelut
- 1868563
En löydä sinua
En löydä sinua täältä, etkä sinä varmaankaan minua. Ennen kirjoitin selkeillä tunnisteilla, nyt jätän ne pois. Varmaan k264668- 504198
- 593742
- 513196
- 502960
Ne oli ne hymyt
Mitä vaihdettiin. Siksi mulla on taas niin järjetön ikävä. Jos haluat musta eroon päästä niin älä huomioi mua. Muuten kä262656- 432461
Anteeksi kun käyttäydyn
niin ristiriitaisesti. Mä en usko että haluaisit minusta mitään, hyvässä tapauksessa olet unohtanut minut. Ja silti toiv382183Miten mä olisin
Rohkeampi lähestymään häntä. En tiedä. En osaa nykyään edes tikusta tehdä asiaa vaan käyttäydyn päin vastoin välttelen.362107