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
5646
Vastaukset 7
- 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
Puukotus Kajaanissa
Kuka puukotti ja ketä? https://yle.fi/a/74-20247765 Vähemmän yllättäen päihteet mainittu611650- 291265
- 851108
- 43925
- 95878
- 67855
Humalassa autolla ajo.
Tuhti humala hyydytti kuljettajan Suomussalmella -sammui rattiin ,uutisoi Ylä-Kainuu.15809Tiesitkö? Jorma Uotisen EX-rakas on Helena Lindgren - Nämä ovat välit nyt: "Me ollaan..."
Jorma Uotinen ja Helena Lindgren olivat avoliitossa v. 1982-1999. Pariskunta oli aikansa näyttävä julkkispari, missä i19755Hyvä on sitten, jos et sitä s*ksiä halua kanssani.
Rakastetaan vaan toisiamme, voin käydä muualla tyydyttämässä fyysisenpuolen tarpeet. Puhumalla tämäkin olisi selvinnyt.131735- 116711
Jäljitelmä Birginit
Ei jumaleisson, Jeffin vaimo kertoo et nää Hermesit olikin jäljitelmiä ja timangit labrarääsää. Anna mun kaikki kestää �151669- 4632
Anteeksi J-mies
Anteeksi että myötävaikutin siihen että rakastuit minuun, jota et voi koskaan saada. Viimeksi kun näimme ja katselimme t78629Suloinen ja herkkä
Toiset huomioiva, räväkkä, yllättävä. Ei sellaisesta voi olla pitämättä.31625- 43611
Minä muistan
Minä muistan sinut nauravana. Sellaisena, joka sai tavallisenkin hetken tuntumaan vähän kevyemmältä, kuin huoneeseen ol45590- 19576
Hyvää yötä hurmuri
Iltaa haaveeni! Kauniita unia😘 Jospa me vielä nähtäis ja juteltais, suukoteltais ja halittais, siliteltäis ja hyväiltä25561- 46558
Olet nainen ollut vaikein rasti
Eniten olet tunteitani myllännyt ja niitä kuluttanut, ja tuottanut. 🤔32540