kunde

Vapaa kuvaus

Isaan Rules WFF CCC If you walked away smiling-then for you the price was right Keep Exceling Suosikkibändit/artistit: Queen, Rammstein, genesis, Bruce Bringsteen, Kino, Mandref Mann Earth band Who Lempikirjat: ohjelmointi... Suosikkipalstat Suomi24 Keskusteluissa: EXCEL, Kivitalot, EPS En pidä: pakkanen ja loskakelit Ruoka & juoma: loimulohi ja valkkari Linkit: http://www.kundepuu.com, Khorat Koulutus: --- Ammatti: Tiede/teknologia Työskentelen: freelancer Ase tai siviilipalvelus: yliluutnantti Siviilisääty: Varattu Lapset: --- Hakusanat: Thaimaa, korat, Excel, VBA, ACAD, CNC, Polyurea, EPS, MgO elementti

Aloituksia

7

Kommenttia

1374

  1. Riippuu+siitä+miten+olet+koodin+tehnyt.Jos+et+halua+poistaa+jo+tehtyä+vektoreita+hipsaa+moduulin+koodissa+poista+funktion+kutsu+tai+nimeä+nimeä+vektorit+siten,+että+niitä+on+helppo+hallita,+lisäämällä+eteen+vaikka+jonkun+erikoismerkin+(esimerkkikoodissa+@-+merkki+eteen)...Funktiot+voi+käsitellä+useampia+vektoreita+kerrallaan.++En+tiedä+mitä+haluat+tehdä+ja+minkälainen+on+taulukkosi,+joten+koodi+vain+ihan+peruspiirtoon.+Jos+haluat+laskea+vektoreita+yhteen+laskea+vektoreiden+välisiä+kulmia+yms.+,+niin+clsVektori+moduulissa+vaan+lisätään+ominaisuuksia+vektoreille+ja+hiukkasen+matematiikkaa...+;-)Sub+Poista()++++Dim+Shp+As+Shape++++On+Error+Resume+Next++++For+Each+Shp+In+ActiveSheet.Shapes+++++++++If+Not+Shp.Name+Like+"@*"+Then+Shp.Delete++++Next+ShpEnd+SubKeep+EXCELing@Kunde
  2. tavalliseen+moduuliin...Option+ExplicitSub+Poista()++++Dim+Shp+As+Shape++++On+Error+Resume+Next++++For+Each+Shp+In+ActiveSheet.Shapes++++++++Shp.Delete++++Next+ShpEnd+SubSub+PiirräVektori()PoistaDim+Vektori1+As+New+ClsVektoriWith+Vektori1'jos+käytät+muuta+kuin+Vektoriluokan+oletusta+aloituspisteelle,+niin+hipsaa+allaolevat+2+riviä...'++++.x1+=+ActiveSheet.Range("P18").Left'++++.y1+=++ActiveSheet.Range("P18").Top'++++pituus++++.Pituus+=+Range("A1").Value'++++kulma++++.Kulma+=+Range("A2").Value'++++skalaari++++.Skalaari+=+10++++.Nimi+=+"Vektori1"++++.PiirräEnd+WithEnd+Sublisää+luokka+moduuli+ja+nimeä+se+ClsVektori+ja+lisää+allaoleva+koodi+sinneOletuksia+voi+lisätä+ja+ominaisuuksia+lisäillä+tarpeen+mukaanOption+ExplicitPublic+x1+As+DoublePublic+y1+As+DoublePublic+Kulma+As+DoublePublic+Pituus+As+DoublePublic+Skalaari+As+DoublePublic+Viivanväri+As+IntegerPublic+Viivanpaksuus+As+DoublePublic+Nimi+As+StringPublic+Pi+As+DoublePrivate+Sub+Class_Initialize()'+oletusarvoja++++x1+=+200++++y1+=+200++++Kulma+=+0++++Pituus+=+10++++Skalaari+=+1++++Pi+=+3.14159265358979++++Viivanväri+=+8++++Viivanpaksuus+=+1End+SubPrivate+Function+Rad(Asteet+As+Double)+As+Double++++Rad+=+Asteet+*+Pi+/+180End+FunctionFunction+x2()+As+Double++++x2+=+x1+++Pituus+*+Sin(Rad(Kulma))+*+SkalaariEnd+FunctionFunction+y2()+As+Double++++y2+=+y1+-+Pituus+*+Cos(Rad(Kulma))+*+SkalaariEnd+FunctionSub+Piirrä()++++With+ActiveSheet.Shapes.AddLine(x1,+y1,+x2,+y2)++++++++.Name+=+Nimi++++++++.Line.EndArrowheadStyle+=+msoArrowheadStealth++++++++.Line.BeginArrowheadStyle+=+msoArrowheadNone++++++++.Line.ForeColor.SchemeColor+=+Viivanväri++++++++.Line.Weight+=+Viivanpaksuus++++End+WithEnd+SubKeep+EXCELing@Kunde
  3. Oikeastihan+vektorille+annetaan+suuntakulma+ja+pituusVoin+tehdä+makron+tommoselle+jos++haluat...++;-)Jos+haluat+jotain+muutakin,+niin+kerro+ja++lisätään+sitten++makroon+Function+Viiva1(x+As+Double,+y+As+Double)+As+DoubleDim+xlShp+As+ShapeSet+xlShp+=+ActiveSheet.Shapes.AddLine(ActiveSheet.Range("P18").Left,+ActiveSheet.Range("P18").Top,+x,+y)xlShp.Line.BeginArrowheadStyle+=+msoArrowheadNonexlShp.Line.EndArrowheadStyle+=+msoArrowheadStealthEnd+FunctionActiveSheet.Shapes("Kundenmalli").DeleteKeep+EXCEling@Kunde
  4. Laitoin+malliksi+hieman+muitakin+juttuja,+mitä+voi+hyödyntää.+On+toki+paljon+muitakin+vielä.+Itsellä+oli+tarve+lisätä++paljon+attribuuttitietoa+(mm+poraukset)+ja+Excelissä+ei+semmoista+ole+objekteilla++mutta+aika+kivuttomasti+se+tollainkin+meni...Tein+myöhemmin+sitten++treeviewllä++yksinkertaisen+rakennepuun,+missä+osia+pystyy+muokkaaman+vapaasti.APIlla+sitten+lomakkeellaoli++helpompaa+fiksailla+kaikkea+ja+näkee+piirron+kanssa+samalla,+mutta+ihan+toimiva++juttu+ja+todistaa+sen,+että+EXCEL+taipuu+moniin+juttuihin,+mihin+sitä+ei+le+alunperin+edes+tarkoitettu++;-)Sub+Suorakaide(X+As+Double,+Y+As+Double,+Leveys+As+Double,+Korkeus+As+Double)Dim+aDim+xlShp+As+ShapeWorksheets(1).Activate'soluun+kiinnitettynäSet+xlShp+=+ActiveSheet.Shapes.AddShape(msoShapeRectangle,+ActiveSheet.Range("C10").Left,+ActiveSheet.Range("c10").Top,+Leveys,+Korkeus)'vasemmasta+yläkulmasta+lähtien'Set+xlShp+=+ActiveSheet.Shapes.AddShape(msoShapeRectangle,+X,+Y,+Leveys,+Korkeus)With+xlShp++++++++.Name+=+"Kundenmalli"++++'tässä+voi+lisätä+atribuuttitietoja+vaihtoehtoinen+teksti+attribuuttiin,+josta+voi+lukea+sitten+kätevästi+tuotteen+tietoja+tai+indoa++++.AlternativeText+=+.Name+&+","+&+Korkeus+&+","+&+Leveys+&+",Tammi"++++'tässä+voi+kätevästi+näyttää+tuotteen+tiedot+hyperlinkillä+kun+hiirellä+siirtyy+kuvion+päälle++++a+=+Split(.AlternativeText,+",")++++ActiveSheet.Hyperlinks.Add+Anchor:=ActiveSheet.Shapes(.Name),+Address:="",+ScreenTip:="Osan+nimi:+"+&+a(0)+&+vbNewLine+&+"Korkeus:+"+&+a(1)+&+vbNewLine+&+"Leveys:+"+&+a(2)+&+vbNewLine+&+"Väri:+"+&+a(3)'tässä+voi+lisätä+materiaalin+tai+värin'++++.Fill.UserPicture+ThisWorkbook.Path+&+"\"+&+"Tammi.jpg"++++.Line.Visible+=+msoTrue++++.Line.Weight+=+0End+With'viivaSet+xlShp+=+ActiveSheet.Shapes.AddLine(ActiveSheet.Shapes("Kundenmalli").Left+++ActiveSheet.Shapes("Kundenmalli").Width,+ActiveSheet.Shapes("Kundenmalli").Top+++ActiveSheet.Shapes("Kundenmalli").Height,+500,+500)xlShp.SelectxlShp.Name+=+"Viiva"End+SubSub+Koe()'tiedot+voi+hakea+solustakin'Suorakaide+Range("A1"),+Range)"B1"),+Range("C1"),+Range("D1")Suorakaide+100,+100,+100,+500End+SubKeep+EXCELing@Kunde
  5. Kyllä+pystyy+piirtämään+kuvioilla+sekä+viivoilla+täysin+parametrisesti+ja+lisäämään+teksturit+kanssa.Itse+olen+tehnyt++parit+kalusteiden+suunnitteluohjelmat,+joissa+piirretään+parametreillä.+Lisätään+esim.+komeron+aukkoihin+erilaisia+objekteja+kuten+hyllyjä,+laatikoita,+koreja+ja+erilaisia+settejä++yms+ja+ohjelma+tekee+myös+tarvittavat+CNC+koodit+komeronosille.+Eli+täysi+paketti+tilauksesta+tuotantoon...+;-)Keep+EXCELing@Kunde
  6. Oma+funktiokoodi+tavalliseen+moduuliin...laita+soluun,+mihin+haluat+tuloksen+kaava+laskee+nyt+tunnit+päiväyksistä+alueelta+E1:E10=LaskeTunnitPäiväyksestä(E1:E10)Function+LaskeTunnitPäiväyksestä(Alue+As+Range)+As+DoubleDim+TunnitDim+Summa+As+DoubleFor+Each+Solu+In+AlueLaskeTunnitPäiväyksestä+=+LaskeTunnitPäiväyksestä+++CDate(Solu)+-+Int(CDate(Solu))NextLaskeTunnitPäiväyksestä+=+LaskeTunnitPäiväyksestä+*+24End+Functionkeep+EXCELing@Kunde
  7. Aika+pahan+kyssärin+heitit++;-)Taulukon+nimen+muutokselle+ei+löydy+tapahtumaa,+mutta+kikkailemalla+sekin+syntyi...Vanhalla+EXCEL4+macrolla+homma+hoituikinThisWorkbook+moduuliin...Option+ExplicitPrivate+Sub+PäivitäTaulukonNimi()ActiveSheet.Range("A1").Formula+=+_++++++++++++"=MID(CELL(""filename"","+&+_+++++++++++++ActiveSheet.Name+&+"!A1"+&+_++++++++++++"),FIND(""]"",CELL(""filename"","+&+_+++++++++++++ActiveSheet.Name+&+"!A1"+&+_++++++++++++"))+1,255)"End+SubPrivate+Sub+Workbook_SheetCalculate(ByVal+Sh+As+Object)On+Error+Resume+NextApplication.EnableEvents+=+FalsePäivitäTaulukonNimiApplication.EnableEvents+=+TrueEnd+SubSub+Reset()Application.EnableEvents+=+TrueApplication.Calculation+=+xlCalculationAutomaticEnd+SubKeep+EXCELing@Kunde
  8. Ihan+turhaa+kirjoitella+joka+taulukolle+omaa+makroaFiksumpi+tapaThisWorkbook+moduuliin...tsekataan+,+että+vain+A1+on+muuttunutPrivate+Sub+Workbook_SheetChange(ByVal+Sh+As+Object,+ByVal+Target+As+Range)If+Not+Intersect(Target,+Sh.Range("A1"))+Is+Nothing+ThenSh.Name+=+Sh.Range("A1")End+IfEnd+Sub
  9. "+Siinä+voi+helposti+tulla+tilanteita+missä+tämän+päivän+ranking+poikkeaisi+aika+paljonkin+huomenna+saman+ihmisen+tekemästä+rankingista."Siksipä+mä+tommosen+koodin+rustasin,+että+voi+tehdä+muutoksia+ja+lista+elää+tilanteen+mukaan...+;-)
  10. lipsahti+ekaksi+fiksaamaton+koodi+tässä+oikea...edelliset+postaukset+eivät+huomioi+sitä+,+että+jos+esim.+ne+100++lukua+,+niin+hankalaa+muistaa+mitä+lukuja+on+jo+käyttänyt+,+koska+luvut+eivät+poistu+luettelosta.Lisähaasteena+tossa+vielä+sekin,+että+jos+haluaa+muuttaa+jo+solussa+olevaa+lukua+vanha+luku+pitää+palauttaa+ja+poistaa+uusi+luku+listasta...no+tossa+koodi...nyt++kelpoisuusehto+H1:H100+ja+luvut+Ki:K100+,+muuta+sopivaksiko++taulukon+moduuliin...Dim+Vanhasolu+As+VariantDim+Uusisolu+As+VariantPublic+TyhjäSolu+As+BooleanPrivate+Sub+Worksheet_SelectionChange(ByVal+Target+As+Range)If+Not+Intersect(Range("H1:H100"),+Target)+Is+Nothing+Then++++If+Target.Count+=+1+Then++++++++If+Target+=+""+Then++++++++++++TyhjäSolu+=+True++++++++Else++++++++++++TyhjäSolu+=+False++++++++End+If++++End+IfEnd+IfEnd+SubPrivate+Sub+Worksheet_Change(ByVal+Target+As+Range)On+Error+Resume+NextApplication.EnableEvents+=+FalseApplication.ScreenUpdating+=+FalseIf+Not+Intersect(Range("H1:H100"),+Target)+Is+Nothing+And+TyhjäSolu+Then++++PoistaLuettelosta+Target++++ActiveWorkbook.Names("Lista").Delete++++vika+=+Range("K1").End(xlDown).Row++++If+Not+Range("K1")+=+""+Then++++++++ActiveWorkbook.Names.Add+Name:="Lista",+RefersTo:=Range("K1:K"+&+vika)++++Else++++++++Range("H1:H100").Validation.Delete++++End+IfElse++++If+Not+Intersect(Range("H1:H100"),+Target)+Is+Nothing+And+Not+TyhjäSolu+Then++++++++Uusisolu+=+Target.Value++++++++Application.Undo++++++++Vanhasolu+=+Target.Value++++++++ActiveWorkbook.Names("Lista").Delete++++++++vika+=+Range("K1").End(xlDown).Row++++++++Range("K"+&+vika+++1)+=+Vanhasolu++++++++ActiveWorkbook.Names.Add+Name:="Lista",+RefersTo:=Range("K1:K"+&+vika+++1)++++++++Worksheets("Sheet1").Sort.SortFields.Clear++++++++Worksheets("Sheet1").Sort.SortFields.Add+Key:=Range("K1:K"+&+vika+++1),+Order:=xlAscending++++++++With+Worksheets("Sheet1").Sort++++++++++++.SetRange+Range("K1:K"+&+vika+++1)++++++++++++.Apply++++++++End+With++++++++Target+=+Uusisolu++++++++Vanhasolu+=+Uusisolu++++++++PoistaLuettelosta+Uusisolu++++End+IfEnd+IfTyhjäSolu+=+FalseApplication.EnableEvents+=+TrueApplication.ScreenUpdating+=+TrueEnd+Subtavalliseen+moduuliin...Sub+resetoi()Application.EnableEvents+=+TrueApplication.ScreenUpdating+=+TrueTyhjäSolu+=+FalseActiveWorkbook.Names.Add+Name:="Lista",+RefersTo:=Range("K1:K100")Range("K1")+=+1Range("K2")+=+2Range("K1:K2").AutoFill+Destination:=Range("K1:K100"),+Type:=xlFillDefaultRange("H1:H100")+=+""With+Range("H1:H100").Validation++++.Delete++++.Add+Type:=xlValidateList,+AlertStyle:=xlValidAlertStop,+Operator:=+_++++++++xlBetween,+Formula1:="=$K$1:$K$100"End+WithEnd+SubSub+PoistaLuettelosta(Hakuehto+As+Variant)Worksheets("Sheet1").ActivateDim+solu+As+RangeWith+Range("K1:K100")Set+solu+=+.Find(+_What:=Hakuehto,+_LookIn:=xlValues,+_LookAt:=xlWhole,+_SearchOrder:=xlByRows,+_SearchDirection:=xlNext,+_MatchCase:=False,+_SearchFormat:=False)If+Not+solu+Is+Nothing+Thensolu.Delete+shift:=xlUpEnd+IfEnd+WithWorksheets("Sheet1").Sort.SortFields.ClearWorksheets("Sheet1").Sort.SortFields.Add+Key:=Range("K1:K100"),+Order:=xlAscendingWith+Worksheets("Sheet1").Sort++++.SetRange+Range("K1:K100")++++.ApplyEnd+WithEnd+SubKeep+EXCELing@Kunde
  11. edelliset+postaukset+eivät+huomioi+sitä+,+että+jos+esim.+ne+100++lukua+,+niin+hankalaa+muistaa+mitä+lukuja+on+jo+käyttänyt+,+koska+luvut+eivät+poistu+luettelosta.Lisähaasteena+tossa+vielä+sekin,+että+jos+haluaa+muuttaa+jo+solussa+olevaa+lukua+vanha+luku+pitää+palauttaa+ja+poistaa+uusi+luku+listasta...no+tossa+koodi...nyt++kelpoisuusehto+H1:H100+ja+luvut+Ki:K100+,+muuta+sopivaksiko++taulukon+moduuliin...Dim+Vanhasolu+As+VariantDim+Uusisolu+As+VariantPublic+TyhjäSolu+As+BooleanPrivate+Sub+Worksheet_SelectionChange(ByVal+Target+As+Range)If+Not+Intersect(Range("H1:H10"),+Target)+Is+Nothing+Then++++If+Target.Count+=+1+Then++++++++If+Target+=+""+Then++++++++++++TyhjäSolu+=+True++++++++Else++++++++++++TyhjäSolu+=+False++++++++End+If++++End+IfEnd+IfEnd+SubPrivate+Sub+Worksheet_Change(ByVal+Target+As+Range)On+Error+Resume+NextApplication.EnableEvents+=+FalseApplication.ScreenUpdating+=+FalseIf+Not+Intersect(Range("H1:H10"),+Target)+Is+Nothing+And+TyhjäSolu+Then++++PoistaLuettelosta+Target++++ActiveWorkbook.Names("Lista").Delete++++vika+=+Range("K1").End(xlDown).Row++++If+Not+Range("K1")+=+""+Then++++++++ActiveWorkbook.Names.Add+Name:="Lista",+RefersTo:=Range("K1:K"+&+vika)++++Else++++++++Range("H1:H100").Validation.Delete++++End+IfElse++++If+Not+Intersect(Range("H1:H10"),+Target)+Is+Nothing+And+Not+TyhjäSolu+Then++++++++Uusisolu+=+Target.Value++++++++Application.Undo++++++++Vanhasolu+=+Target.Value++++++++ActiveWorkbook.Names("Lista").Delete++++++++vika+=+Range("K1").End(xlDown).Row++++++++Range("K"+&+vika+++1)+=+Vanhasolu++++++++ActiveWorkbook.Names.Add+Name:="Lista",+RefersTo:=Range("K1:K"+&+vika+++1)++++++++Worksheets("Sheet1").Sort.SortFields.Clear++++++++Worksheets("Sheet1").Sort.SortFields.Add+Key:=Range("K1:K"+&+vika+++1),+Order:=xlAscending++++++++With+Worksheets("Sheet1").Sort++++++++++++.SetRange+Range("K1:K"+&+vika+++1)++++++++++++.Apply++++++++End+With++++++++Target+=+Uusisolu++++++++Vanhasolu+=+Uusisolu++++++++PoistaLuettelosta+Uusisolu++++End+IfEnd+IfTyhjäSolu+=+FalseApplication.EnableEvents+=+TrueApplication.ScreenUpdating+=+TrueEnd+Subtavalliseen+moduuliin...Sub+resetoi()Application.EnableEvents+=+TrueApplication.ScreenUpdating+=+TrueTyhjäSolu+=+FalseActiveWorkbook.Names.Add+Name:="Lista",+RefersTo:=Range("K1:K100")Range("K1")+=+1Range("K2")+=+2Range("K1:K2").AutoFill+Destination:=Range("K1:K100"),+Type:=xlFillDefaultRange("H1:H100")+=+""With+Range("H1:H100").Validation++++.Delete++++.Add+Type:=xlValidateList,+AlertStyle:=xlValidAlertStop,+Operator:=+_++++++++xlBetween,+Formula1:="=$K$1:$K$100"End+WithEnd+SubSub+PoistaLuettelosta(Hakuehto+As+Variant)Worksheets("Sheet1").ActivateDim+solu+As+RangeWith+Range("K1:K10")Set+solu+=+.Find(+_What:=Hakuehto,+_LookIn:=xlValues,+_LookAt:=xlWhole,+_SearchOrder:=xlByRows,+_SearchDirection:=xlNext,+_MatchCase:=False,+_SearchFormat:=False)If+Not+solu+Is+Nothing+Thensolu.Delete+shift:=xlUpEnd+IfEnd+WithWorksheets("Sheet1").Sort.SortFields.ClearWorksheets("Sheet1").Sort.SortFields.Add+Key:=Range("K1:K10"),+Order:=xlAscendingWith+Worksheets("Sheet1").Sort++++.SetRange+Range("K1:K10")++++.ApplyEnd+WithEnd+SubKeep+EXCELing@Kunde
  12. Sub+PoistaTuplat()Dim+Alue+As+RangeDim+TuplaAlue+As+RangeDim+Solu+As+RangeDim+Vika+As+LongOn+Error+GoTo+virhe'aktiivisen+solun+sarake+hakusarakkeenaSet+Alue+=+Range(Cells(1,+ActiveCell.Column),+Cells(Cells(65536,+ActiveCell.Column).End(xlUp).Row,+ActiveCell.Column))Alue.AdvancedFilter+Action:=xlFilterInPlace,+Unique:=TrueSet+TuplaAlue+=+NothingFor+Each+Solu+In+Alue++++If+Solu.EntireRow.Hidden+Then++++++++If+Not+Solu+=+""+Then++++++++++++If+TuplaAlue+Is+Nothing+Then++++++++++++++++Set+TuplaAlue+=+Solu++++++++++++Else++++++++++++++++Set+TuplaAlue+=+Union(TuplaAlue,+Solu)++++++++++++End+If++++++++End+If++++End+IfNextIf+Not+TuplaAlue+Is+Nothing+Then++++TuplaAlue.EntireRow.DeleteElse++++Exit+SubEnd+IfActiveSheet.ShowAllDataExit+Subvirhe:MsgBox+"Valitse+sarake+klikkaamalla+haluamasi+sarakkeen+solua+tietoalueelta"End+SubKeep+EXCELing@Kunde
  13. unohtui+se+linkki+videollehttps://www.dropbox.com/s/jajgi6oimsjdv44/Suomi24.mp4?dl=0
  14. vaikeeta+vastata+kun+bannaa+mut+kokoajan...+tein+videon+,+missä+mun+2010++ohjelma++toimii+ihan+OkTsekkaa+ja+kokeile+alla+olevalla+koodilla+ja+jos+herjaa+jotakin,++niin+infoatossa+koodi+Private+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+RangeDim+x'ohitetaan+virhetilanteetOn+Error+Resume+Next'peruutetaan+normaalitulostusCancel+=+True'estetään+Excelin+reakointi+tapahtumiin+ja+näytön+päivitysa++poisApplication.EnableEvents+=+FalseApplication.ScreenUpdating+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Or+IsEmpty(solu.Offset(0,+-1))+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'kopioidaan+tiedot+alasRange("130:230").Delete'jos+et+halua+1-3++riviä+siirtää+vaihda+hipsun+paikka+allaolevilla+2++rivillä'Range("4:100").SpecialCells(xlCellTypeVisible).Copy+Range("A130")Range("1:100").SpecialCells(xlCellTypeVisible).Copy+Range("A130")'Range("4:100").SpecialCells(xlCellTypeVisible).Copy+Range("A130")'määritellään+tulostusalueActiveSheet.PageSetup.PrintArea+=+"$A$4:$F$100"'näytetään+tulostuksen+esikatseluActiveSheet.PrintPreviewx+=+MsgBox("Tulostetaanko?",+vbYesNo,+"Tulostus")If+x+=+6+Then++++'tulostetaan+sivu++++ActiveWindow.SelectedSheets.PrintOutEnd+If'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueApplication.ScreenUpdating+=+TrueEnd+SubKeep+EXCELing@Kunde
  15. melkoista+lypsämistä,+eikö+toiveet+voisi+esittää+kerralla+....Private+Sub+Workbook_SheetChange(ByVal+Sh+As+Object,+ByVal+Target+As+Range)On+Error+Resume+NextIf+Sh.Index+>+2+And+Sh.Index+<+24+Then++++If+Not+Intersect(Target,+Rows("6:20"))+Is+Nothing+Then++++++++Application.EnableEvents+=+False++++++++If+WorksheetFunction.CountA(Target.EntireRow)+=+1+Then++++++++++++Target.Offset(2,+0).EntireRow.Hidden+=+True++++++++Else++++++++++++Target.Offset(2,+0).EntireRow.Hidden+=+False++++++++End+If++++End+IfEnd+IfApplication.EnableEvents+=+TrueEnd+SubKeep+EXCEling
  16. Liitä+allaoleva+koodi++ThisWorkBook(TämäTyökirja)+moduuliin+ja+poista+vanha+koodi+ko.taulukon++moduulista.Private+Sub+Workbook_SheetChange(ByVal+Sh+As+Object,+ByVal+Target+As+Range)On+Error+Resume+NextIf+Not+Intersect(Target,+Rows("6:20"))+Is+Nothing+Then++++Application.EnableEvents+=+False++++If+WorksheetFunction.CountA(Target.EntireRow)+=+1+Then++++++++Target.Offset(2,+0).EntireRow.Hidden+=+True++++Else++++++++Target.Offset(2,+0).EntireRow.Hidden+=+False++++End+IfEnd+IfApplication.EnableEvents+=+TrueEnd+SubKeep+EXCELing@Kunde
  17. muuta+koodissaIf+WorksheetFunction.CountA(Target.EntireRow)+=+1+ThenKeep+EXCEling@Kunde
  18. Private+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+RangeDim+x'ohitetaan+virhetilanteetOn+Error+Resume+Next'estetään+Excelin+reakointi+tapahtumiinApplication.EnableEvents+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Or+IsEmpty(solu.Offset(0,+-1))+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'määritellään+tulostusalueActiveSheet.PageSetup.PrintArea+=+"$A$4:$F$100"'näytetään+tulostuksen+esikatseluActiveSheet.PrintPreviewx+=+MsgBox("Tulostetaanko?",+vbYesNo,+"Tulostus")If+x+=+6+Then++++'tulostetaan+sivu++++ActiveWindow.SelectedSheets.PrintOut++++Range("A130:A230").Delete++++Range("1:100").SpecialCells(xlCellTypeVisible).Copy+Range("A130")End+If'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'peruutetaan+normaalitulostusCancel+=+True'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueEnd+SubKeep+EXCELing@Kunde
  19. Rivi+riviltä+koodinajoValitse+koodinsta+joku+ei+kommentti+rivi+ja+painele+F8++näppäintä+ja+koodia+suoritetaan+rivi+kerrallaan.+Voit+lisätä+stopin+koodiin+klikkaamalla+sitä+koodialueella+vasemmalla+olevaa+harmaata+palkkia++hiiren+vasemmalla+painikkeella.+Nyt+koodi+suoritetaan+siihen+stopiin+asti+ja+ja+jatketaan+F8+ivi+kerrallaan+tai+F5+loppuun+asti.Esikatselusta+poistut+ESC+tai+klikkaamalla+poistunappia.+Kysyy+sitten+haluatkotulostaa+jne...Private+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+Range'ohitetaan+virhetilanteetOn+Error+Resume+Next'estetään+Excelin+reakointi+tapahtumiinApplication.EnableEvents+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Or+IsEmpty(solu.Offset(0,+-1))+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'määritellään+tulostusalueActiveSheet.PageSetup.PrintArea+=+"$A$4:$F$100"'näytetään+tulostuksen+esikatseluActiveSheet.PrintPreviewx+=+MsgBox("Tulostetaanko?",+vbYesNo,+"Tulostus")If+x+=+6+Then++++'tulostetaan+sivu++++ActiveWindow.SelectedSheets.PrintOutEnd+If'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'peruutetaan+normaalitulostusCancel+=+True'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueEnd+SubKeep+EXCELing@Kunde
  20. Resetointi+makro+on+siltä+varalle,+jos+koodia+askel+askeleelta+suoritat+ja++koko+makroa+ei+ajeta+loppuun+syystä+tai+toisesta+eli++toi+rivi+jää+suorimattamatta,++ei+Excelsitten++reagoitapahtumiin.+Siis+ihan+helpottamaan+elämää+toi+koodi...++;-)tossa+nyt+pyytämäsi+päivityksetPrivate+Sub+Workbook_BeforePrint(Cancel+As+Boolean)Dim+solu+As+Range'ohitetaan+virhetilanteetOn+Error+Resume+Next'estetään+Excelin+reakointi+tapahtumiinApplication.EnableEvents+=+False'muuta+ehto+sopivaksi'täsää+käydään+solualue+läpi+solu+kerrallaanFor+Each+solu+In+Range("F4:F100")'tarkistetaan+onko+hinta+solussa++++If+Not+IsEmpty(solu)+Or+IsEmpty(solu.Offset(0,+-1))+Then'++++piilotetaan+rivi,+jos+hinta+solussa++++++++solu.EntireRow.Hidden+=+True++++End+IfNext'määritellään+tulostusalueActiveSheet.PageSetup.PrintArea+=+"$A$4:$F$100"'tulostetaan+sivuActiveWindow.SelectedSheets.PrintOut'palautetaan+piilotetut+rivitRows("4:100").EntireRow.Hidden+=+False'peruutetaan+normaalitulostusCancel+=+True'palautetaan+Excel+normaalitilaanApplication.EnableEvents+=+TrueEnd+SubKeep++EXCELing@Kunde
    21. 7 / 69
TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt