allineare pulsanti in una cella

[raimea]

ciao

sempre in merito alla gestione di > oggetti in una cella
dopo aver scopeto che possono essere cancellati con vba
mi vien da chiedere:

e' possibile allineare l'oggetto al centro della cella con vba ?

in fgl generale
col C da C8:C
ci sono dei quadratini ai quali associo un colleg. ipertest.
vorrei riuscire , se possibile, a metterli al centro della relativa cella.

vi allego il file

https://www.dropbox.com/scl/fi/if5o7nloys1qq67rwkp0x/allinea-pulsanti.xlsm?rlkey=b9t7j4i0x5jue0aobz7jtynn9&dl=0


ciao

[Anthony47]

Derivato dal codice dell’attuale Sub RemPulsanti:

Codice: Seleziona tutto

Sub CentraPulsanti()
Dim Shp As Shape
'
For Each Shp In ActiveSheet.Shapes
'    Debug.Print Shp.Type, Shp.Name, Shp.TopLeftCell.Address(0, 0)
    If Shp.Type = msoPicture Then
        If Shp.TopLeftCell.Column = 3 And Shp.TopLeftCell.Row > 8 Then                         'vedi nota**
            Shp.Top = Shp.TopLeftCell.Top + (Shp.TopLeftCell.Height - Shp.Height) / 2
            Shp.Left = Shp.TopLeftCell.Left + (Shp.TopLeftCell.Width - Shp.Width) / 2
        End If
    End If
Next Shp
End Sub


** forse deve essere If Shp.TopLeftCell.Column = 3 And Shp.TopLeftCell.Row >= 8?

[raimea]

ciao
e' tutto ok

grazie mille

ciao

[raimea]

ciao
sempre in merito agli oggetti, nelle celle di fgl generale

ora posso: cancellarli e allinearli.

chiedo

sarebbe possibile copiare il 1mo oggetto in cella C8
e incollarlo nelle successive 100 celle da C9 ?

allego il file

https://www.dropbox.com/scl/fi/ydbvf062ffkk03aooew2t/incolla-oggetti.xlsm?rlkey=dy8qlp8kgv3q4gjkfhkaxepb6&dl=0

ciao

[Anthony47]

Modifica la tua Sub CentraPulsant come segue:

Codice: Seleziona tutto

Sub DuplicaEtCentraPulsanti()
Dim Shp As Shape
'----------------
' luglio 23 da pc-facile Anthony
' serve a duplicare e allineare i pulsantini in col C al centro delle celle
' http://www.pc-facile.com/forum/viewtopic.php?f=26&t=113041&p=664639&sid=511c36e58a902e069f48ca91d1fbed38#p664639
'-----------------------
Dim RemArea As String, taShp As Shape, myC As Range
RemArea = "C9:C100"
'
'Rimuovi Shapes dalle celle di destinazione:
For Each Shp In ActiveSheet.Shapes
    If Shp.Type = msoPicture Then
        If Not Application.Intersect(Range(RemArea), Shp.TopLeftCell) Is Nothing Then
            Shp.Delete
        Else
            If Shp.TopLeftCell.Address = "$C$8" Then
                Set taShp = Shp
            End If
        End If
    End If
Next Shp
'Copia e aggiungi:
taShp.Copy
DoEvents
For Each myC In Range(RemArea)
    DoEvents
    myC.PasteSpecial xlPasteAll
Next myC
'Centra nella cella
For Each Shp In ActiveSheet.Shapes
'    Debug.Print Shp.Type, Shp.Name, Shp.TopLeftCell.Address(0, 0)
    If Shp.Type = msoPicture Then
        If Shp.TopLeftCell.Column = 3 And Shp.TopLeftCell.Row >= 8 Then    ' 3=col C                      'vedi nota**
            Shp.Top = Shp.TopLeftCell.Top + (Shp.TopLeftCell.Height - Shp.Height) / 2
            Shp.Left = Shp.TopLeftCell.Left + (Shp.TopLeftCell.Width - Shp.Width) / 2
        End If
    End If
Next Shp
Range("C8").Select
End Sub


Noterai le modifiche per eliminare eventuali forme dalle celle destinatarie, copiarvi la cella campione, e infine allinearle col codice preesistente

[raimea]

ciao
tutto ok
grazie

[raimea]

ciao

con la macro precedente,
allinea gli oggetti nelle celle di una COLONNA

Codice: Seleziona tutto

Sub CentraPulsanti()
Dim Shp As Shape
'----------------
' luglio 23 da pc-facile entony
' serve ad allineare i pulsantini in col G al centro delle celle
' http://www.pc-facile.com/forum/viewtopic.php?f=26&t=113041&p=664639&sid=511c36e58a902e069f48ca91d1fbed38#p664639
'
' centra i pulsanti di col G
'-----------------------


For Each Shp In ActiveSheet.Shapes
'    Debug.Print Shp.Type, Shp.Name, Shp.TopLeftCell.Address(0, 0)
    If Shp.Type = msoPicture Then
        If Shp.TopLeftCell.Column = 7 And Shp.TopLeftCell.Row >= 8 Then    ' 7=col G                      'vedi nota**
            Shp.Top = Shp.TopLeftCell.Top + (Shp.TopLeftCell.Height - Shp.Height) / 2
            Shp.Left = Shp.TopLeftCell.Left + (Shp.TopLeftCell.Width - Shp.Width) / 2
        End If
    End If

Next Shp

End Sub

ora avrei bisogno di allineare degli oggetti (immagini)
al centro di una RIGA

in riga 4 da col G : N
vorrei mettere asl centro delle celle.

(io Ho fatto delle prove ma non sono riuscito !)



ciao

[Anthony47]

Credo che questo snippet dovrebbe fare il lavoro:

Codice: Seleziona tutto

For Each Shp In ActiveSheet.Shapes
    If Shp.Type = msoPicture Then
        If Shp.TopLeftCell.Row = 4 Then
            If Shp.Height < Range("A4").Height Then         ' **Vedi testo
                Shp.Top = Shp.TopLeftCell.Top + (Shp.TopLeftCell.Height - Shp.Height) / 2
                Shp.Left = Shp.TopLeftCell.Left + (Shp.TopLeftCell.Width - Shp.Width) / 2
            End If
        End If
    End If
Next Shp

Questo presuppone che le immagini di cui parliamo giacciano già su riga 4; non controllo che le colonne siano G:N dando per scontato che non ci siano altre immagini su riga 4 che invece vorresti lasciare immutate; se ho assunto male allora lo aggiungiamo.

C'e' da tener presente che questi codici (anche quello che allinea su colonna) sono potenzialmente distruttivi, SE l'altezza o la larghezza delle immagini fossero maggiori dell'altezza della riga o della larghezza della colonna. Ho quindi inserito un ulteriore If (riga marcata **) per controllare che la condizione potenzialmente distruttiva non sia vera

Prova...

[raimea]

ciao
tutto ok

Questo presuppone che le immagini di cui parliamo giacciano già su riga 4; non controllo che le colonne siano G:N dando per scontato che non ci siano altre immagini su riga 4 che invece vorresti lasciare immutate; se ho assunto male allora lo aggiungiamo.

Si.. si...
nelle celle di riga 4 ci sono GIA' le immagini
e solo 1 immagine

grazie