| | Post: 12 | Registrato il: 09/08/2019
| Città: ROMA | Età: 48 | Utente Junior | excel 2013 | | OFFLINE | |
|
02/03/2023 10:48 | |
Buongiorno a tutti
Con questo ciclo, importo l'immagine su una form e anche su un foglio di lavoro, e din qui tutto bene.
Ors ho l'esigenza di adattare la foto del foglio di lavoro ad una serie di celle unite tra loro.
Qui c'è qualcosa che non va...
Potreste aiutarmi...
Grazie
Allego uno screenshot
|
|
| | Post: 7.148 | Registrato il: 14/11/2004
| Utente Master | Office 2019 | | OFFLINE |
|
02/03/2023 11:32 | |
Ciao Daniele le celle unite sono un pugno nell'occhio per Excel ed il VBA.
diciamo che per .Top e .Left potrebbe andare bene, perche indicano l'angolo superiore sx della prima cella ma resta il problema di .Height e .Width che sono la larghezza e l'altezza prova ed inserire direttamente dei valori del tipo a caso devi vedere tu la dimensione ed adattare le misure
.Height = 45
.width = 120
ricorda che per inserire i decimali nel VBA si usa il punto, 120.58
Ciao By Sal (8-D
[Modificato da by sal 02/03/2023 11:33] se ti piace la soluzione sostienici con una DONAZIONE a piacere. Grazie clicca qui |
| | Post: 3.401 | Registrato il: 06/04/2013
| Utente Master | 2010 | | OFFLINE |
|
02/03/2023 12:41 | |
ciao
potresti farlo nel seguente modo
ipotizziamo che tu abbia un range di celle unite B2:C8, pertanto 7 righe e 2 colonne
- ti posizioni nel range (quindi in pratica excel ti segnala B2 nella casella Nome in alto a sinistra.
dopo l'istruzione
With ActiveSheet.Pictures.Insert(mPa......
valorizzi le seguenti variabili
mTop = ActiveCell.Top
mLeft = ActiveCell.Left
mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(6).Address).Height
mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 1).Address).Width
(dove 6 e 1 sono rispettivamente le righe(-1) di cui è composto il range unito e le colonne(-1)
e quindi
.Top = mTop
.Left = mLeft
.Width = mWidth
.Height = mHeight
saluti
[Modificato da dodo47 02/03/2023 13:23] Domenico
Win 10 - Excel 2016 |
| | Post: 14 | Registrato il: 09/08/2019
| Città: ROMA | Età: 48 | Utente Junior | excel 2013 | | OFFLINE | |
|
03/03/2023 08:12 | |
prima di tutto vi ringrazio per il Vostro aiuto
ma il codice continua a non funzionare in entrambe i casi
l'ho riscritto adottando la soluzione di Dodo:
On Error GoTo RigaErrore
Dim s As String
Dim sPath As String
Dim mtop As Variant
Dim mleft As Variant
Dim mHeight As Variant
Dim mWidth As Variant
s = TextBox3.Text & ".jpg"
sPath = "\\...\AAAAAFOTO\"
With Me.Image46
.Picture = LoadPicture(sPath & s)
End With
Sheets("FP").Select
ActiveSheet.Pictures.Delete
Range("B2").Select
With ActiveSheet.Pictures.Insert(sPath & s).Select
mtop = ActiveCell.Top
mleft = ActiveCell.Left
mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(6).Address).Height
mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 1).Address).Width
.Top = mtop
.Left = mleft
.Width = mWidth
.Height = mHeight
End With
Sheets("PP").Select
Exit Sub
RigaErrore:
MsgBox "immagine non trovata" 'Err.Number & vbNewLine & Err.Description
Image46.Picture = LoadPicture("")
Sheets("PP").Select
quando arriva alla riga ".Top = mtop" mi da errore
c'è qualcosa che mi sfugge :) |
| | Post: 3.402 | Registrato il: 06/04/2013
| Utente Master | 2010 | | OFFLINE |
|
03/03/2023 09:32 | |
ciao
non funziona non vuol dire nulla, spiega che accade e sarebbe bene che tu allegassi un esempio del tuo file, senza dati sensibili in quanto vedo che sei all'interno di una uForm. Non puoi pensare che ci ricostruiamo la tua struttura......
Ti posso solo garantire che quanto suggerito inserisce un'immagine in un range di celle unite delle relative dimensioni.
Ora vedo che ha lasciato inalterato il codice suggerito quindi hai un range unito composto da 7 righe e 2 colonne??
Hai preventivamente disunito il range e poi riunito??
saluti
[Modificato da dodo47 03/03/2023 09:58] Domenico
Win 10 - Excel 2016 |
| | Post: 15 | Registrato il: 09/08/2019
| Città: ROMA | Età: 48 | Utente Junior | excel 2013 | | OFFLINE | |
|
03/03/2023 09:57 | |
Ciao Dodo buongiorno
ti ringrazio in anticipo per l'interesse...
purtroppo il file che dovrei allegare è grande e contiene anche dati sensibili, perciò mi riesce impossibile allegarlo.
il problema è che avviando la macro mi da questo errore
in questa riga
perciò mi esce dal ciclo |
| | Post: 3.403 | Registrato il: 06/04/2013
| Utente Master | 2010 | | OFFLINE |
|
03/03/2023 10:16 | |
ciao
capisci bene che non sono in grado di capire il perchè senza vedere un file.
Creane uno essenziale compresa lòa Uform dettagliando bene cosa fare.
L'errore 424 sembra dire che manchi l'oggetto del .Top, ma.......
Comunque ti allego un test:
Nella stessa cartella dove copi l'allegato metti una foto chiamata MiaFoto.jpg (o cambia nome nel codice)
saluti
Questo il codice contenuto:
Sub InsFoto()
mFile = ActiveWorkbook.Path & "\MiaFoto.jpg"
nRighe = Range("D4").MergeArea.Rows.Count
nColonne = Range("D4").MergeArea.Columns.Count
Range("D4").Select
Selection.UnMerge
With ActiveSheet.Pictures.Insert(mFile)
.ShapeRange.LockAspectRatio = msoFalse
mTop = ActiveCell.Top
mLeft = ActiveCell.Left
mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(5).Address).Height
mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 2).Address).Width
.Top = mTop
.Left = mLeft
.Width = mWidth
.Height = mHeight
End With
Range(ActiveCell.Address & ":" & ActiveCell.Offset(5, 2).Address).Merge
End Sub [Modificato da dodo47 03/03/2023 10:18] Domenico
Win 10 - Excel 2016 |
| | Post: 16 | Registrato il: 09/08/2019
| Città: ROMA | Età: 48 | Utente Junior | excel 2013 | | OFFLINE | |
|
03/03/2023 10:16 | |
in pratica non adatta la dimensione della foto al range b2:c8
ho anche trascritto il codice per provarlo su un nuovo foglio di lavoro, ma il problema pesiste
sempre dalla riga .Top = mtop in poi
se lascio "On Error GoTo RigaErrore...." attivo
il problema viene baipassato, mi inserisce la foto ma non la adatta,
se tolgo "On Error GoTo RigaErrore..." il codice si blocca alla riga che ti ho indicato in precedenza
spero di essere stato più esplicito :) |
| | Post: 17 | Registrato il: 09/08/2019
| Città: ROMA | Età: 48 | Utente Junior | excel 2013 | | OFFLINE | |
|
03/03/2023 10:49 | |
Grazie Dodoooooooo
funzionaaaaaa
sei stato gentilissimo e tanto paziente
l'ultimo codice che mi hai passato funziona perfettamente, l'ho solo riadattato e inserito nella Private Sub che già avevo
in pratica questo è il risultato finale:
Private sub ........
On Error GoTo RigaErrore
Dim s As String
Dim mFile As String
Dim nRighe As String
Dim nColonne As String
Dim mtop As Variant
Dim mleft As Variant
Dim mHeight As Variant
Dim mWidth As Variant
s = TextBox3.Text & ".jpg"
mFile = "\\....\AAAAAFOTO\"
With Me.Image46
.Picture = LoadPicture(mFile & s)
End With
s = TextBox3.Text & ".jpg"
mFile = "\\...\AAAAAFOTO\"
nRighe = Range("P1").MergeArea.Rows.Count
nColonne = Range("P1").MergeArea.Columns.Count
Sheets("FP").Select
ActiveSheet.Pictures.Delete
Range("P1").Select
Selection.UnMerge
With ActiveSheet.Pictures.Insert(mFile & s)
.ShapeRange.LockAspectRatio = msoFalse
mtop = ActiveCell.Top
mleft = ActiveCell.Left
mHeight = Range(ActiveCell.Address & ":" & ActiveCell.Offset(10).Address).Height
mWidth = Range(ActiveCell.Address & ":" & ActiveCell.Offset(, 4).Address).Width
.Top = mtop
.Left = mleft
.Width = mWidth
.Height = mHeight
End With
Range(ActiveCell.Address & ":" & ActiveCell.Offset(10, 4).Address).Merge
Sheets("PP").Select
Exit Sub
RigaErrore:
MsgBox "immagine non trovata"
Image46.Picture = LoadPicture("")
Sheets("PP").Select
end sub
Ti ringrazio veramente ;) |
| | Post: 1.062 | Registrato il: 24/06/2015
| Città: CATANIA | Età: 80 | Utente Veteran | Excel2019 | | OFFLINE |
|
03/03/2023 11:11 | |
Buongiorno a tutti
Confermo che la macro di @dodo47 (ciao Domenico) è perfettamente funzionante.
Forse (e ripeto forse) la adatterei a 6 righe e DUE colonne (attualmente adatta la foto a 6 righe e TRE colonne)
Ciao,
Mario |
| | Post: 3.404 | Registrato il: 06/04/2013
| Utente Master | 2010 | | OFFLINE |
|
03/03/2023 13:00 | |
Marius44, 03/03/2023 11:11:
Buongiorno a tutti
Confermo che la macro di @dodo47 (ciao Domenico) è perfettamente funzionante.
Forse (e ripeto forse) la adatterei a 6 righe e DUE colonne (attualmente adatta la foto a 6 righe e TRE colonne)
Ciao,
Mario
Si certo Mario....erano numeri buttati a caso....
grazie e un carissimo saluto
E.Daniele
Non sono d'accordo sulla tua gestione errore.
Non è detto che se la macro va in errore sia perchè non ha trovato l'immagine, può capitare anche altro
Ti ripropongo il codice con le modifiche che io applicherei.
Sub InsFoto()
On Error GoTo RigaErrore
.......
.......
Selection.UnMerge
If Dir(mfile) = "" Then
MsgBox "immagine non trovata"
Image46.Picture = LoadPicture("")
Sheets("PP").Select
Exit Sub
End If
With ActiveSheet.Pictures.Insert(mfile)
.......
.......
Range(ActiveCell.Address & ":" & ActiveCell.Offset(5, 2).Address).Merge
Exit Sub
RigaErrore:
MsgBox Err.Number & " - " & Err.Description
End Sub
[Modificato da dodo47 03/03/2023 13:21] Domenico
Win 10 - Excel 2016 |
| | Post: 18 | Registrato il: 09/08/2019
| Città: ROMA | Età: 48 | Utente Junior | excel 2013 | | OFFLINE | |
|
03/03/2023 15:05 | |
Si Dodo
Il mio riferimento all'errore era solo per dire che comunque il problema esisteva e veniva baipassato.
Comunque con la macro che mi hai inviato stamattina funziona tutto alla perfezione.
Ora purtroppo non sono in ufficio e non posso provare le ultime modifiche che mi hai inviato.
Ma ri ringrazio comunque |
|
|