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
5616
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
Virkamiehille tarvitaan tuntuvat palkankorotukset
Naistenpäivänä on syytä muistuttaa, että virkamiehen euro on vain 80 senttiä. Palkat tulee saattaa samalle tasolle yksi494143Riikka Purran kaudella nousi bensan hinta yli 2 euron
Muistatteko kuinka edellisen vasemmistohallituksen aikana, ns. Marinin aikakaudella, bensiiniä sai 1,3 euron litrahinnal663803- 703328
Olisipa saanut sinuun
Tutustua paremmin. Harmi että aloin lopulta jännittämään kun näytit tunteesi niin voimakkaasti ja lähestyit niin voimaak963230Mitäs nyt sijoittajat?
Pörssit laskevat maailmalla Iranin sodan takia ja muutenkin ovat olleet Trumpin vallan alla epävarmat. Ainoa, mikä on no942227- 352138
- 241999
- 361989
- 381969
Olisitpa se hellä
Ja herkkä minkä kuvan sain sinusta irl. Haluaisin että elämässäni olisi sellainen joka arvostaa minua juuri sellaisena k231874