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

344

Äänestä

    Vastaukset

    Anonyymi (Kirjaudu / Rekisteröidy)
    5000
    • kunde

      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

      • kunde
        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ä.

    Takaisin ylös

    Luetuimmat keskustelut

    1. Keitä täällä on??

      Kertokaa nimenne!! 🤔
      Ikävä
      110
      1104

    2. Tiedät, että en voi enää laittaa viestiä

      Aikaa kulunut. Eikä se näyttäisi enää luontevalta vastata näin pitkän ajan jälkeen. Tiedän myös, että sinä et enää lait
      Ikävä
      82
      824

    3. Nostetaanpas kissa pöydälle: Onko Kuhmossa työpaikkakiusaamista?

      Kuka uskaltaa puhua? Vai uskaltaako kukaan? Naisvaltaisella alalla on kuulemma Kuhmossa ruma tilanne. Mitä aikuiset ede
      Kuhmo
      18
      659

    4. Tuleeko Martinasta rouva Muhis

      Saako vihdoinkin ne haaveilemansa prinsessa häät Hajjin entinen Muhammad kanssa, 😂 yhteistä heillä on se, että molemmat
      Kotimaiset julkkisjuorut
      271
      631

    5. Mitä hyvää

      Mitä hyvää hän on tuonut elämääsi?
      Ikävä
      77
      598

    6. Ei enää kauaa rakkaani

      Ensin minun pitää saatella narsistit oikeuden eteen ❤️
      Ikävä
      104
      574

    7. Mitä sanoisit

      juuri nyt kaivatullesi jos uskaltaisit/kehtaisit?
      Ikävä
      54
      547

    8. Miten näytät / näytit ihastumisesi hänelle?

      Toimiko, miten hän vastasi? vinkki5
      Ikävä
      26
      522

    9. Oletko miettinyt sitä

      Että jos meidän persoonat ei sovi yhtään yhteen ;) No onneksi kumpikin on fiksu eikä halua toiselle mitään pahaa.
      Ikävä
      49
      513

    10. Eipä oo näkyny montakkasn etelänvetelää vielä kylällä.

      Liekkö tuo pensanhinta vetelille liian kallista, kun ovat jeäneet kesäksi kottiinsa vetelehtimmään. Pärjätään iliman vet
      Suomussalmi
      88
      438
    Aihe
    TietosuojaselosteKäyttöehdotEvästeasetuksetSäännöt