-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Új hozzászólás Aktív témák
-
Delila_1
veterán
válasz
apeelme #19609 üzenetére
Nem tudom, mi a feladat, miket akarsz másolni, de van megoldás.
A gomb használata a dátum beírásához szükségtelen, mivel a naptár Click eseménye beírja azt a megfelelő helyre. Ehelyett bevihetjük a másolást, ha az rendre a másolat helyétől azonos távolságra történik, de egy Select Case utasításban módosíthatjuk is. A lenti makró a kijelölt területet 1 sorral lentebb, és 3 oszloppal jobbra másolja.Private Sub CommandButton1_Click()
Selection.Copy Cells(Selection.Row + 1, Selection.Column + 3)
End SubA gombnak mindig láthatónak kell lennie a másolás végrehajtásához, ezért a Worksheet_SelectionChange makró is változik.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Column
Case 2, 3
Me.Calendar1.Left = ActiveCell.Left + ActiveCell.Width + 2
Me.Calendar1.Top = ActiveCell.Top + ActiveCell.Height
Me.Calendar1.Visible = True
Me.CommandButton1.Top = Me.Calendar1.Top + Me.Calendar1.Height
Me.CommandButton1.Left = Me.Calendar1.Left
Case Else
Me.CommandButton1.Top = ActiveCell.Top + ActiveCell.Height
Me.CommandButton1.Left = ActiveCell.Left + ActiveCell.Width + 2
Me.Calendar1.Visible = False
End Select
End SubÍrd le pontosan, milyen esetekben mit és hova akarsz másolni, akkor könnyebb segíteni.
-
Delila_1
veterán
válasz
apeelme #19605 üzenetére
Ezen sajnos nem tudok változtatni, de ha már rákérdeztél, a lentebbi makrót leegyszerűsítheted. A 2. és 3. oszlophoz együttesen is meg lehet adni a naptár helyzetét.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Column
Case 2, 3
Me.Calendar1.Left = ActiveCell.Left + ActiveCell.Width + 2
Me.Calendar1.Top = ActiveCell.Top + ActiveCell.Height
Me.Calendar1.Visible = True
Me.CommandButton1.Left = Me.Calendar1.Left
Me.CommandButton1.Top = Me.Calendar1.Top + Me.Calendar1.Height
Me.CommandButton1.Visible = True
Case Else
Me.Calendar1.Visible = False
Me.CommandButton1.Visible = False
End Select
End Sub -
Delila_1
veterán
válasz
apeelme #19570 üzenetére
Jobb klikkel rákattintva megnézed, a kettő közül melyik a Calendar1. Azt meghagyod, a másikat törlöd.
A makrók:
Private Sub Calendar1_Click()
If Selection.Column = 2 Then Cells(Selection.Row, 2) = Me.Calendar1.Value
If Selection.Column = 3 Then Cells(Selection.Row, 3) = Me.Calendar1.Value
End Sub
Private Sub CommandButton1_Click()
Me.Calendar1.Today
Cells(Selection.Row, 2) = Me.Calendar1.Value
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Column
Case 2
Me.Calendar1.Left = ActiveCell.Left + ActiveCell.Width + 2
Me.Calendar1.Top = ActiveCell.Top + ActiveCell.Height
Me.Calendar1.Visible = True
Me.CommandButton1.Left = Me.Calendar1.Left
Me.CommandButton1.Top = Me.Calendar1.Top + Me.Calendar1.Height
Me.CommandButton1.Visible = True
Case 3
Me.Calendar1.Left = ActiveCell.Left + ActiveCell.Width + 2
Me.Calendar1.Top = ActiveCell.Top + ActiveCell.Height
Me.Calendar1.Visible = True
Me.CommandButton1.Left = Me.Calendar1.Left
Me.CommandButton1.Top = Me.Calendar1.Top + Me.Calendar1.Height
Me.CommandButton1.Visible = True
Case Else
Me.Calendar1.Visible = False
Me.CommandButton1.Visible = False
End Select
End Sub
Új hozzászólás Aktív témák
- Notebook hibák
- HP notebook topic
- AMD Navi Radeon™ RX 9xxx sorozat
- AMD Ryzen 9 / 7 / 5 7***(X) "Zen 4" (AM5)
- Otthoni hálózat és internet megosztás
- EarFun Air Pro 4 - a cél a csúcs
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- Hobby elektronika
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- Meghalt a Windows 10, éljen a Windows 10!
- További aktív témák...
- Árváltozás+játék DVD: Borderlands 2 Ultimate Loot Chest Limited Edition
- Fallout 3 Collector's Edition (lunchbox)
- Árváltozás+játék!The Witcher 2 Assassins of Kings Collector's Edition
- Árváltozás: Deus Ex Human Revolution Collector's Edition
- Árváltozás+játék DVD: Bioshock Infinite Ultimate Songbird Edition
- DELL PowerEdge R740 rack szerver - 2xGold 6130 (16c/32t, 2.1/3.7GHz), 64GB RAM, 10Gbit HBA330, áfás
- Keresünk dokkolókat
- BESZÁMÍTÁS! ASUS B450M R5 5500 16GB DDR4 512GB SSD RTX 2070 Super 8GB DEEPCOOL Tesseract SW 600W
- Dell Precision 7560 Workstation i7-11850H 32GB RAM 512GB SSD Nvidia T1200 4GB 1 év garancia
- DELL Docking Station WD19S + 130W töltő
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Laptopműhely Bt.
Város: Budapest