CommandButtonien tuhoaminen

Uuden oppija

Olen tehnyt CommandButtonin jonka makro lisää CommandButtoneita toiselle sivulle ja aina CommandButtonin nimi muuttuu (CommandButton1, CommandButton2.....)


Private Sub CommandButton4_Click()
' Tässä pitäisi tulla tilattu työ tulostukseen
LISAYS
End Sub

Sub LISAYS()
'
' Macro7 Macro
' Macro recorded 9.7.2009 by JLe
'

'
Range("A2").Select
Sheets("TILATUT TYÖT").Select
Range("A2").Select
Rows("6:6").Select
Selection.Insert Shift:=xlDown
Sheets("Data").Select
Range("A15:E15").Select
Selection.Copy
Sheets("TILATUT TYÖT").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("F7").Select
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False, _
DisplayAsIcon:=False, Left:=700, Top:=110, Width:=75, Height:=15) _
.Select
Selection.ShapeRange.IncrementLeft -9.75
Selection.ShapeRange.IncrementTop -5.25
Selection.ShapeRange.ScaleHeight 0.82, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementTop 3.75
Selection.ShapeRange.IncrementTop -2.25
Selection.ShapeRange.ScaleWidth 0.12, msoFalse, msoScaleFromTopLeft
Range("F6").Select
Sheets("Data").Select
Range("A3").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("A4").Select
End Sub




Allan on makro joka on liitettynä jokaiseen tilatun työn CommandButtoniin


Sub KOPIOINTI_POISTO()
'
' Macro1 Macro
' Macro recorded 23.7.2009 by JLe
'

'
Dim cBox As CommandButton

Sheets("Data").Select
Rows("17:17").Select
Selection.Insert Shift:=xlDown
Range("A7").Select
Sheets("TILATUT TYÖT").Select
Range("B7:F7").Select
Selection.Copy
Range("A6").Select
Sheets("Data").Select
Range("A18").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A8").Select
End Sub



Nyt tähän pitäisi saada lisättyä Poisto makroon sellainen että se poistaisi kyseisen CommandButtonin ja rivin missä oli painettu Button, rivejä voi olla vaikka 20 missä on buttoneita

Voisiko joku auttaa...

3

286

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • Ilmeisesti haluat siirtää Data taulukosta tilaustiedot A15:E15 alueelta TILATUT TYÖT taulukkoon alekkain tehdä riville napin, jolla sitten tilauksen voi palauttaa alekkain Data taulukkoon alkaen riviltä 17?
      jos näin niin alla oleva koodi tekee sen. Helppo muokata sopivaksi
      moduuliin...

      Dim vika As Integer
      Sub LISAYS()
      Dim ylä As Double
      Dim vasen As Double
      Dim korkeus As Double
      Dim leveys As Double
      On Error Resume Next
      Application.ScreenUpdating = False
      Worksheets("TILATUT TYÖT").Activate
      vika = Range("B65536").End(xlUp).Row 1
      'tiedot alkaen riviltä 7 jos ei niin muuta?
      If vika < 7 Then vika = 7
      Range("Data!A15:E15").Copy Destination:=Range("B" & vika)
      With Range("H" & vika)
      ylä = .Top
      vasen = .Left
      korkeus = .Height
      leveys = .Width
      End With
      ActiveSheet.Buttons.Add(vasen, ylä, leveys, korkeus).Select
      Selection.OnAction = "KOPIOINTI_POISTO"
      Range("B" & vika).Select
      Application.ScreenUpdating = True
      End Sub
      Sub KOPIOINTI_POISTO()
      Dim rivi As Integer
      On Error Resume Next
      Application.ScreenUpdating = False
      rivi = ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row
      vika = Range("Data!B65536").End(xlUp).Row 1
      'tiedot takaisin alkaen riviltä 17, jos ei niin muuta?
      If vika < 17 Then vika = 17
      Range("B" & rivi & ":F" & rivi).Copy Destination:=Range("Data!A" & vika)
      Rows(ActiveSheet.Buttons(Application.Caller).TopLeftCell.Row).Delete Shift:=xlUp
      ActiveSheet.Shapes(Application.Caller).Select
      Selection.Cut
      Application.ScreenUpdating = True
      End Sub

      ja nappisi koodi pysyy samana

      Private Sub CommandButton4_Click()
      ' Tässä pitäisi tulla tilattu työ tulostukseen
      LISAYS
      End Sub

      • Uuden oppija

        Terve Kunde

        Tämä oli todella hyvä toimii.... nyt otan vielä selville mitä kaikki tarkoittavat niin ymmärrän paremmin mitä olen tekemässä.

        TÄMÄ OLI LOISTAVAA KIITOS PALJON


      • Uuden oppija kirjoitti:

        Terve Kunde

        Tämä oli todella hyvä toimii.... nyt otan vielä selville mitä kaikki tarkoittavat niin ymmärrän paremmin mitä olen tekemässä.

        TÄMÄ OLI LOISTAVAA KIITOS PALJON

        Hiukkasen spesiaalijuttujahan siinä on, mitä ei voi oppia kuin treenaamalla ja makronauhoittimella ei saa tommosta koodia aikaiseksi...
        Keep Excelling
        @Kunde


    Ketjusta on poistettu 0 sääntöjenvastaista viestiä.

    Luetuimmat keskustelut

    1. Yritän tänään laittaa taajuudet kohdilleen

      Jotta törmätään kirjaimellisesti. Ei tätä kestä enää perttikään. Olet rakas ❤️
      Ikävä
      66
      2328
    2. Onko kaivattusi

      kyltymätön nainen, pystyisitkö olemaan hänelle loputon mies, vai meneekö toisinpäin.
      Ikävä
      38
      1903
    3. Viulu vaiennut

      Eikö pisnikset suju ? Vai miksi pahin yrittäjä vouhka on "kadonnu" maan alle. 🤣
      Suomussalmi
      29
      1646
    4. Vanhuksen varpaankynsien leikkaus 89 euroa...

      Huh huh.......Parturikäynti olisi varmasti ollut 250 euroa? Kallis on suomi nykyään.
      Maailman menoa
      176
      1603
    5. Anne Kukkohovi. Myy likaisia alushousujaan.

      Kuka ihme ostaa jonkun naisen likaisia alushousuja, menee lujaa kyllä tälläkin housujen myyjällä.
      Kotimaiset julkkisjuorut
      99
      1479
    6. Nainen, sellaista tässä ajattelin

      Minulla on olo, että täällä on edelleen joku, jolla on jotain käsiteltävää. Hän ei ole päässyt lähtemään vielä vaan jost
      Ikävä
      185
      1253
    7. Kauanko skuutteja on siedettävä? Ei tietoa liikennesäännöistä, ajellaan miten sattuu ja missä vain.

      Kauanko on kestettävä sähköpotkulautojen terrorismismia? Niillä ajelevat eivät tiedä, tai jos tietävätkin, niin eivät vä
      Maailman menoa
      128
      1226
    8. Kyllä tekee kipeää

      Luopua kaikesta mitä on elämässä saavuttanut😞 ei vaan ole enää yhtäkään hiljaista vuorokautta🤬
      Ikävä
      25
      1146
    9. En mä tiedä mitä tapahtuu

      siis tykkäisitköhän musta oikeasti. Ehkä oot pelannu liikaa rahapelejä, ehkä rakastat tyhjiä arpoja.
      Ikävä
      9
      962
    10. Luotatko kaivattuusi?

      Jos et, mistä kiikastaa?
      Ikävä
      77
      959
    Aihe