Hi everyone,
I use a macro to insert pictures from a folder, but since I migrated from 2003 to 2007, pictures doesn't insert at the top of the row, sometimes they insert below or above of it.
Thing is: I have a 2003 workbook (let's call it "good workbook") where insert pictures (with the same macro) and pictures's top is right, I mean, all pictures are placed at the top left of the row.
And most strange thing is: if I copy all pictures from a "bad workbook" and paste them to "good workbook", pictures are paste just correctly, and if I copy all pictures from "good workbook" and paste them to a bad one, pictures's top doesn't match and they're place up or down of the row.
I've tried removing freezing, removing filter, set page margins to zero, macro to "correct" the top, inserting pictures with another macro, and the result keeps being the same.
Please, can someone tell me how to solve this misterious behavior of my excel or worksheets.
This is the macro I use to insert.
Sub OTS()
Dim R_Pic As Range
Dim P_Path As String
Dim H, W, C, R As Integer
Application.ScreenUpdating = False
C = 10
R = 35
H = 34
W = 51.24
If ActiveCell.Column = 1 Then
Range("A1").EntireColumn.Insert
Range("A1").ColumnWidth = C
Else
Selection.Offset(0, -1).Select
ActiveCell.EntireColumn.ColumnWidth = C
End If
Selection.Offset(0, 1).Select
For Each R_Pic In Selection
R_Pic.RowHeight = R
R_Pic.EntireRow.VerticalAlignment = xlCenter
P_Path = "Z:\" & R_Pic & ".jpg"
Set rngOutput = ActiveSheet.Range(Cells(R_Pic.Row, R_Pic.Column - 1).Address(False, False, xlA1), Cells(R_Pic.Row, R_Pic.Column - 1).Address(False, False, xlA1))
If Dir(P_Path) <> "" Then
With ActiveSheet.Pictures.Insert(P_Path)
.Left = rngOutput.Left
.Top = rngOutput.Top
.Height = H
.Width = W
End With
End If
Next
Application.ScreenUpdating = True
End Sub
And the macro I use to "correct" (obviously without any sucess)
Sub correct_imgs()
Dim img As Shape
Dim F, F2 As Integer
F = 7
For Each img In ActiveSheet.Shapes
F2 = F
While F2 <> 0
If Left(img.AlternativeText, 14) = Cells(F2, 2).Value Then
Cells(F2, 2).Select
'MsgBox (img.Top & Chr(10) & Cells(F2, 1).Top)
img.Top = Cells(F2, 1).Top
F = F2
F2 = -1
End If
F2 = F2 + 1
Wend
F = F + 1
Next
End Sub
At this link you'll find samples of the two workbooks (bad and good)
http://rapidshare.com/files/404148316/Images.zip.html
Thanks for your help or reply...
I use a macro to insert pictures from a folder, but since I migrated from 2003 to 2007, pictures doesn't insert at the top of the row, sometimes they insert below or above of it.
Thing is: I have a 2003 workbook (let's call it "good workbook") where insert pictures (with the same macro) and pictures's top is right, I mean, all pictures are placed at the top left of the row.
And most strange thing is: if I copy all pictures from a "bad workbook" and paste them to "good workbook", pictures are paste just correctly, and if I copy all pictures from "good workbook" and paste them to a bad one, pictures's top doesn't match and they're place up or down of the row.
I've tried removing freezing, removing filter, set page margins to zero, macro to "correct" the top, inserting pictures with another macro, and the result keeps being the same.
Please, can someone tell me how to solve this misterious behavior of my excel or worksheets.
This is the macro I use to insert.
Sub OTS()
Dim R_Pic As Range
Dim P_Path As String
Dim H, W, C, R As Integer
Application.ScreenUpdating = False
C = 10
R = 35
H = 34
W = 51.24
If ActiveCell.Column = 1 Then
Range("A1").EntireColumn.Insert
Range("A1").ColumnWidth = C
Else
Selection.Offset(0, -1).Select
ActiveCell.EntireColumn.ColumnWidth = C
End If
Selection.Offset(0, 1).Select
For Each R_Pic In Selection
R_Pic.RowHeight = R
R_Pic.EntireRow.VerticalAlignment = xlCenter
P_Path = "Z:\" & R_Pic & ".jpg"
Set rngOutput = ActiveSheet.Range(Cells(R_Pic.Row, R_Pic.Column - 1).Address(False, False, xlA1), Cells(R_Pic.Row, R_Pic.Column - 1).Address(False, False, xlA1))
If Dir(P_Path) <> "" Then
With ActiveSheet.Pictures.Insert(P_Path)
.Left = rngOutput.Left
.Top = rngOutput.Top
.Height = H
.Width = W
End With
End If
Next
Application.ScreenUpdating = True
End Sub
And the macro I use to "correct" (obviously without any sucess)
Sub correct_imgs()
Dim img As Shape
Dim F, F2 As Integer
F = 7
For Each img In ActiveSheet.Shapes
F2 = F
While F2 <> 0
If Left(img.AlternativeText, 14) = Cells(F2, 2).Value Then
Cells(F2, 2).Select
'MsgBox (img.Top & Chr(10) & Cells(F2, 1).Top)
img.Top = Cells(F2, 1).Top
F = F2
F2 = -1
End If
F2 = F2 + 1
Wend
F = F + 1
Next
End Sub
At this link you'll find samples of the two workbooks (bad and good)
http://rapidshare.com/files/404148316/Images.zip.html
Thanks for your help or reply...
