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
5603
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
Marin sitä, Marin tätä, yhyy yhyy, persut jaksaa vollottaa
On nuo persut kyllä surkeaa porukkaa. Edelleen itkevät jonkun Marinin perään, vaikka itse ovat tuhonneet Suomen kansan t1444169Ikävä sinua..
Kauan on aikaa kulunut ja asioita tapahtunut. Mutta sinä M-ies olet edelleen vain mielessäni. En tiedä loinko sinusta va212142Riikka Purra: "Kokoomus haluaa leikata pienituloisten etuuksista - Se ei meille käy"
Näin vakuutti persujen Purra edellisten eduskunta vaalien alla,. https://www.ku.fi/artikkeli/4910942-kun-uudessa-videos521768Riikka Purra sanoo, että sietokykyni vittumaisiin ihmisiin alkaa olla lopussa.
https://www.iltalehti.fi/politiikka/a/be8f784d-fa24-44d6-b59a-b9b83b629b28 Riikka Purra sanoo medialle suorat sanat vitt3511633Muistattekos kuinka persujen Salainen Akentti kävi Putinin leirillä
Hakemassa jamesbondimaista vakoiluoppia paikan päällä Venäjällä? Siitä ei edes Suomea suojeleva viranomainen saanut puhu221449Lindtmanin pääministeriys lähenee päivä päivältä
Suomen kansan kissanpäivät alkavat siitä hetkestä, kun presidentti Stubb on tehnyt nimityksen. Ainoastaan ylin tulodesi471425Kapiainen siviiliesimies, Herra suuri Herra
Sotilaana kyvytön, johtajana munaton ja kotona tossun alla. Se on upseerin uran tuen pää, seinään ajo. Mutta aina löytyy801324Tuntuuko sinusta mies
että olet jossain, mutta sydämessäsi haluat olla muualla. Suunnittelet kaikkea kivaa ja olet innolla mukana, mutta silti211116Väärä pää tutustumiseen
Mikä ihme on, että miehet haluavat ensimmäisenä sänkyyn? Onko nykyään niin helppo saada nainen peittojensa alle.. tai pä1461101- 611042