Új hozzászólás Aktív témák

• #2594 Delila_1 veterán salmiakki #2593

  Új Válasz 2015-02-26 16:35:22 #2594

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz salmiakki #2593 üzenetére

  Próbáld meg abban a táblázatban kiszűrni az átfedéseket. Ott valószínűleg egyszerűbben megteheted, mint a beszúrt objektumoknál.

• #2592 Delila_1 veterán salmiakki #2591

  Új Válasz 2015-02-26 08:38:50 #2592

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz salmiakki #2591 üzenetére

  Azt írd le, hogy kerülnek a lapra az objektumok. Hátha akkor könnyebb ellenőrizni a helyzetüket, illetve eleve jó helyre lehetne tenni.
  A már meglévő ábráknál nagyon sok, egymást ütő feltételt kell vizsgálni.

• #2590 Delila_1 veterán salmiakki #2587

  Új Válasz 2015-02-25 16:05:25 #2590

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz salmiakki #2587 üzenetére

  Igaz, hogy Control-t kérdeztél, de ez a makró az eddig felvitt legalsó és jobb szélső elemek bármilyen objektum alá-, és tőle jobbra 5 ponttal helyezi az új objektumot.

  Sub UjElem()
  Dim Bal As Single, Lent As Single, i As Long
  
  For i = 1 To ActiveSheet.Shapes.Count
  With ActiveSheet.Shapes(i)
  If .Left + .Width > Bal Then Bal = .Left + .Width + 5
  If .Top + .Height > Lent Then Lent = .Top + .Height + 5
  End With
  Next
  
  ActiveSheet.Shapes.AddShape(msoShapeRectangle, Bal, Lent, 70#, 58#).Select
  End Sub

  Az

  ActiveSheet.Shapes.AddShape(msoShapeRectangle, Bal, Lent, 70#, 58#).Select

  sorban kell meghatároznod az új elem típusát. A két utolsó érték helyére írd be a kívánt szélességet, és magasságot. Ez most egy téglalapot tesz be, de ha a sor helyett ezt írod:

  ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
  DisplayAsIcon:=False, Left:=Bal, Top:=Lent, Width:=102.75, Height:=25.5).Select

  akkor egy beviteli mezőt tesz a megfelelő helyre.

  Ez meg szépen egymás alá teszi a beviteli mezőket:

  Sub mm()
  Dim Bal As Single, Lent As Single, i As Long
  
  For i = 1 To ActiveSheet.Shapes.Count
  With ActiveSheet.Shapes(i)
  If .Left > Bal Then Bal = .Left
  If .Top + .Height > Lent Then Lent = .Top + .Height + 3
  End With
  Next
  
  ActiveSheet.OLEObjects.Add(ClassType:="Forms.TextBox.1", Link:=False, _
  DisplayAsIcon:=False, Left:=Bal, Top:=Lent, Width:=69.75, Height:=24).Select
  End Sub

• #2589 Delila_1 veterán salmiakki #2587

  Új Válasz 2015-02-25 12:05:54 #2589

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz salmiakki #2587 üzenetére

  A lenti makró az újonnan betett objektum helyzetét vizsgálja, de csak az előtte berakott utolsóhoz képest. Ha az utolsó előttit takarja, üzenetet küld. Az ábrán kiemelt rész mutatja, hogy olyan esetben is jelez, ha látszólag nincs takarás, de a valóságban igen.

  Sub Takar_e()
  Dim elozo As Integer
  Dim B_uj As Single, J_uj As Single, F_uj As Single, A_uj As Single
  Dim B_elozo As Single, J_elozo As Single, F_elozo As Single, A_elozo As Single
  Dim Vizsz As Boolean, Fugg As Boolean
  
  Vizsz = False: Fugg = False
  
  'Új alakzat adatai
  With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
  B_uj = .Left 'bal szél
  J_uj = .Left + .Width 'jobb szél
  F_uj = .Top 'felső pont
  A_uj = .Height + .Top 'alsó pont
  End With
  
  'Előző alakzat adatai
  elozo = ActiveSheet.Shapes.Count - 1
  With ActiveSheet.Shapes(elozo)
  B_elozo = .Left 'bal szél
  J_elozo = .Left + .Width 'jobb szél
  F_elozo = .Top 'felső pont
  A_elozo = .Top + .Height 'alsó pont
  End With
  
  If B_uj >= B_elozo And B_uj <= J_elozo Then Vizsz = True
  If J_uj >= B_elozo And J_uj <= J_elozo Then Vizsz = True
  If F_uj >= F_elozo And F_uj <= A_elozo Then Fugg = True
  If A_uj >= F_elozo And A_uj <= A_elozo Then Fugg = True
  
  If Vizsz = True And Fugg = True Then
  MsgBox "Az előző (" & ActiveSheet.Shapes(elozo).Name & " nevű) objektum takarásban van", vbExclamation
  Else: MsgBox "Nincs takarásban az előző objektum"
  End If
  End Sub

  

• #2588 sztanozs veterán salmiakki #2587

  Új Válasz 2015-02-25 11:54:39 #2588

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  sztanozs

  veterán

  válasz salmiakki #2587 üzenetére

  Próbáld meg lerajzolni azokat a helyzeteket, amikor egy kontrol takar egy másikat és ez alapján meglesznek a megoldások.

Új hozzászólás Aktív témák