inserire immagini con VBA che restino all'interno del foglio

[a...@a.it]

Ciao a tutti riprendo il mio post di ieri.
Con la macro qui sotto, inserisco le immagini nel mio foglio e fin qui va
bene.
Poi però quando salvo e chiudo il foglio e poi lo riapro, in un altro pc, al
posto delle foto mi appaiono die quadrati trasparenti con una "X" in cui c'è
scritto: "Impossibile visualizzare l'immagine COLLEGATA. E' possibile che il
file sia stato spostato....."

Ma io non l'ho collegata l'immagine...l'ho inserita!
Come posso modificare la macro affinchè me la inserisca al posto di
collegarla?
La macro:

Public Sub inserisci_Immagini()

Dim sImmagine As String
Dim sPath As String
Dim c As Range
Dim rng As Range
Dim sh As Worksheet
Dim lLarghezza As Long

sPath = "C:\immagini\"
Set sh = Worksheets("pippo")

With sh
Set rng = .Range("H680:H1210")
For Each c In rng
If c.Value <> "" Then
sImmagine = ""
sImmagine = sPath & _
c.Value
If Dir(sImmagine) <> "" Then
c.Select
.Pictures.Insert( _
sImmagine).Select
Selection.ShapeRange.Width = _
c.Width
End If
End If
Next

End With

Set c = Nothing
Set rng = Nothing
Set sh = Nothing

End Sub



Grazie.
Sini

[Norman Jones]

Hi Sini,

Prova qualcosa del genere:

'=============>>
Option Explicit

'------------->>
Public Sub inserisci_Immagini()
Dim WB As Workbook
Dim SH As Worksheet

Dim sImmagine As String
Dim sPath As String
Dim c As Range
Dim rng As Range

Dim myShape As Shape
Const sAddress As String = "H680:H1210"

Set WB = ThisWorkbook
Set SH = WB.Worksheets("Pippo")
sPath = "C:\immagini\"

With Application
If Right(sPath, 1) <> .PathSeparator Then
sPath = sPath & .PathSeparator
End If
On Error GoTo ErrH
.ScreenUpdating = False
End With

With SH
Set rng = .Range(sAddress)
For Each c In rng.Cells

If c.Value <> "" Then
sImmagine = ""
sImmagine = sPath & _
c.Value
If Dir(sImmagine) <> "" Then

Set myShape = .Shapes.AddPicture _
(Filename:=sImmagine, _
LinkToFile:=True, _
SaveWithDocument:=True, _
Left:=100, _
Top:=100, _
Width:=70, _
Height:=70)
With myShape
.Top = c.Top
.Width = c.Width
.Left = c.Left
.Height = c.Height
End With
End If
End If
Next c

End With

XIT:

Set c = Nothing
Set rng = Nothing

Set SH = Nothing

Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub

ErrH:
Call MsgBox("Error " _
& Err.Number & " (" _
& Err.Description & ")")
Resume XIT
End Sub
'<<=============



===
Regards,
Norman

[a...@a.it]

Hi Norman San ;-)
ho provato, ma mi da errore qui:

Set SH = WB.Worksheets("Pippo")

WB.Worksheets("Pippo") = <indice non incluso nell'intervallo">

Come posso risolvere?

[Norman Jones]

Ciao Sini,

Ho utilizzato Pippo come un nome generico da essere sostituito con il
nome vero del foglio interessato.

Avrei aggiunto l'istruzione:

Set SH = WB.Worksheets("Pippo") *'<<==== Cambia*

se non avessi preso il nome Pippo dal tuo codice.


===
Regards,
Norman

[a...@a.it]

Set SH = WB.Worksheets("Pippo") *'<<==== Cambia*

--------------------------------------------------

Ciao Norman,
questo l'avevo capito e visto l'errore avevo prima cambiato "Pippo" al
codice da te scritto e provato la macro, ma niente da fare.
Poi non contento...ho cambiato anche il nome del foglio in "Pippo"
(lasciando inalterato quello del tuo codice) per vedere se cosi almeno
funzionava...ma niente..

[r]

Il giorno giovedì 23 gennaio 2014 15:16:22 UTC+1, a...@a.it ha scritto:

> Ciao Norman,
>
> questo l'avevo capito e visto l'errore avevo prima cambiato "Pippo" al
>
> codice da te scritto e provato la macro, ma niente da fare.
>
> Poi non contento...ho cambiato anche il nome del foglio in "Pippo"
>
> (lasciando inalterato quello del tuo codice) per vedere se cosi almeno
>
> funzionava...ma niente..

Ciao
Il messaggio di errore è dovuto al fatto che il foglio Pippo non esiste in thisworkbook ... quindi se tu hai un foglio di nome Pippo vuol dire che dove hai incollato il codice non è un modulo standard di quella cartella di lavoro. Puoi ovviare copiando il modulo nella tua cartella di lavoro sostituendo thisworkbook con activeworkbook.

saluti
r

[Norman Jones]

Ciao Sini

Se si verifica l'errore in quella riga questo suggerirebbe che nessun
foglio con il nome specificato è stato trovato nella cartella di lavoro
specificata; di conseguenza, supponendo che il numero di errore sia
l'errore 9, sei sicuro che il foglio interessato si trova nella stessa
cartella di lavoro il mio codice?

In caso affermativo, prova a caricare la cartella di lavoro a un
servizio come Dropbox o SkyDrive e poi incolla il link in questo thread.


===
Regards,
Norman

[a...@a.it]

Ciao
Il messaggio di errore è dovuto al fatto che il foglio Pippo non esiste in
thisworkbook ... quindi se tu hai un foglio di nome Pippo vuol dire che dove
hai incollato il codice non è un modulo standard di quella cartella di
lavoro. Puoi ovviare copiando il modulo nella tua cartella di lavoro
sostituendo thisworkbook con activeworkbook.

Ciao r,
grazie.
Infatti avevo incollato la macro sul personal.xls invece del file xls.
Ho risolto come hai detto tu, ho messo activeworkbook

Grazie.

[a...@a.it]

Se si verifica l'errore in quella riga questo suggerirebbe che nessun
foglio con il nome specificato è stato trovato nella cartella di lavoro
specificata; di conseguenza, supponendo che il numero di errore sia
l'errore 9, sei sicuro che il foglio interessato si trova nella stessa
cartella di lavoro il mio codice?

------------------------------------------------------------------

Ciao Norman,

grazie.
Infatti avevo incollato la macro sul personal.xls invece del file xls.

Ho risolto come ha detto r, ho messo activeworkbook
Ora tutto funziona e le immagini mi restano.
Solo una cosa però...quando le immagini vengono incollate nel foglio excel
risultano della misura (larghezza e altezza) della cella.
Per capirci...se una foto fosse 100X100 px, quando viene inserita, se la
cella dove viene inserita fosse di 20X50 px, la foto risulterebbe di 20x50.
Nella "mia" macro iniziale, questo non succedeva, quando veniva importata,
era delle dimensioni che volevo io (75px di default).

E' possibile applicare tutto ciò anche alla tua macro? O forse no perchè
magari lavora in maniera diversa rispetto alla "mia"?

Ed possibile far partire la macro senza specificare il file col nome PIPPO,
ma bensi sul foglio in cui mi trovo?

Intanto posto la macro "corretta" dell' "errore":

Option Explicit

'------------->>
Public Sub inserisci_Immagini()
Dim WB As Workbook
Dim SH As Worksheet
Dim sImmagine As String
Dim sPath As String
Dim c As Range
Dim rng As Range
Dim myShape As Shape

Const sAddress As String = "H1:H30"

Set WB = ActiveWorkbook
Set SH = WB.Worksheets("pippo")
'WB.Worksheets("pippo")

sPath = "C:\immagini\"

With Application
If Right(sPath, 1) <> .PathSeparator Then
sPath = sPath & .PathSeparator
End If
On Error GoTo ErrH
.ScreenUpdating = False
End With

With SH
Set rng = .Range(sAddress)
For Each c In rng.Cells
If c.Value <> "" Then
sImmagine = ""
sImmagine = sPath & _
c.Value
If Dir(sImmagine) <> "" Then
Set myShape = .Shapes.AddPicture _
(Filename:=sImmagine, _
LinkToFile:=True, _
SaveWithDocument:=True, _
Left:=100, _
Top:=100, _

Width:=100, _
Height:=100)

[Norman Jones]

Ciao A,

Prova a sostituire il codice precedente con la seguente versione:

'=============>>

Option Explicit

'------------->>
Public Sub inserisci_Immagini()
Dim WB As Workbook
Dim SH As Worksheet
Dim sImmagine As String
Dim sPath As String
Dim c As Range
Dim rng As Range
Dim myShape As Shape

Dim dHeight As Double
Dim dWidth As Double
Const sAddress As String = "H680:H1210"
Const WidthConversionFactor As Double = 5.368

Set SH = ActiveSheet

sPath = "C:\immagini\"

With Application
If Right(sPath, 1) <> .PathSeparator Then
sPath = sPath & .PathSeparator
End If
On Error GoTo ErrH
.ScreenUpdating = False
End With

With SH
Set rng = .Range(sAddress)

rng.Cells(1).ColumnWidth = 5 '\\ Arbitrary low value

For Each c In rng.Cells
If c.Value <> "" Then
sImmagine = ""
sImmagine = sPath & _
c.Value
If Dir(sImmagine) <> "" Then
Set myShape = .Shapes.AddPicture _
(Filename:=sImmagine, _
LinkToFile:=True, _
SaveWithDocument:=True, _
Left:=100, _
Top:=100, _

Width:=70, _
Height:=70)

With myShape
.Top = c.Top

.Left = c.Left
.ScaleHeight 1, msoTrue
.ScaleWidth 1, msoTrue
If .Width > c.Width Then
c.ColumnWidth = .Width / WidthConversionFactor
End If
c.RowHeight = .Height

End With
End If
End If
Next c

End With

XIT:
Set c = Nothing
Set rng = Nothing
Set SH = Nothing

Application.ScreenUpdating = True
On Error GoTo 0
Exit Sub

ErrH:
Call MsgBox("Error " _
& Err.Number & " (" _
& Err.Description & ")")
Resume XIT
End Sub

'<<=============



===
Regards,
Norman

[Norman Jones]

Ciao A,

Vorrei cogliere l'occasione per aggiornare il mio procedimento al fine
di eliminare tre variabili inutilizzate ed esplicitamente ricavare il
valore della variabile www. Pertanto. il codice da utilizzare diventa:

'=============>>
Option Explicit

'------------->>
Public Sub inserisci_Immagini()

Dim SH As Worksheet
Dim sImmagine As String
Dim sPath As String
Dim c As Range
Dim rng As Range
Dim myShape As Shape

Dim WidthConversionFactor
Const sAddress As String = "H680:H1210" '<<==== Cambia

Set SH = ActiveSheet
sPath = "C:\immagini\"

With Application
If Right(sPath, 1) <> .PathSeparator Then
sPath = sPath & .PathSeparator
End If
On Error GoTo ErrH
.ScreenUpdating = False
End With

With SH

With .Columns(1)
WidthConversionFactor = .Width / .ColumnWidth
End With
Set rng = .Range(sAddress)

[a...@a.it]

-------------------------------------------------------------------------

Ciao Norman,

scusa se scrivo solo ora, ma sono stato via fino ad oggi.
Intanto vorrei ringraziarti per tutto, e proverò la macro nel pomeriggio e
poi ti so dire.
Grazie e buon lavoro!

[a...@a.it]

------------------------------------------------------------------------------

Ciao Nornan!
Testata e tutto ok.
Solo 2 cose...
1) Quando si inseriscono le immagini, la riga aumenta in altezza in base
alle dimensioni dell'immagine...(nel caso sopra H 70).E' possibile fare in
modo che le righe restino della loro altezza naturale?

2) E' normale che le immagini ci impieghino 5-6 secondi per apparire quando
apro il file?

Grazie ancora!

[Norman Jones]

On 27/01/2014 15:24, a...@a.it wrote:
> Ciao Nornan!
> Testata e tutto ok.
> Solo 2 cose...
> 1) Quando si inseriscono le immagini, la riga aumenta in altezza in base
> alle dimensioni dell'immagine...(nel caso sopra H 70).E' possibile fare
> in modo che le righe restino della loro altezza naturale?
>
> 2) E' normale che le immagini ci impieghino 5-6 secondi per apparire
> quando apro il file?
>
> Grazie ancora!

Ciao A,

Nella mia esperienza, questo non sarebbe del tutto normale. Forse
potresti caricare un file di esempio (senza dati sensibili) su DropBox
o SkyDrive e poi postare il link qui?



===
Regards,
Norman

[a...@a.it]

Ciao A,

Nella mia esperienza, questo non sarebbe del tutto normale. Forse
potresti caricare un file di esempio (senza dati sensibili) su DropBox
o SkyDrive e poi postare il link qui?

---------------------------------------------------------------------------------------------

Ciao Norman,

ora funziona tutto bene.
Forse mi faceva il discorso sopra perche magari avevo la ram occupata dalle
immagini.
Ho chiuso excel e riaperto, ho riprovato ad aprire il file e si è aperto
normalmente senza ritardi.
Grazie ancora dell'aiuto!