Cet article vous apporte des connaissances pertinentes sur excel, qui organise principalement les problèmes liés à la façon d'interroger des images par nom, y compris comment insérer des images d'une feuille de calcul à une autre feuille de calcul, en fonction des données Noms d'image dans la colonne A du tableau, insertion par lots de photos du tableau de photos dans la colonne B du tableau de données, etc. Examinons-les ensemble, j'espère que cela sera utile à tout le monde.
Recommandations d'apprentissage associées : Tutoriel Excel
Comment insérer des images d'une feuille de calcul à une autre ? Donnez un exemple.
Comme indiqué ci-dessous :
Un classeur comporte deux feuilles de calcul.
La feuille de calcul dans laquelle les photos sont stockées s'appelle [Photos] et la feuille de calcul dans laquelle les images doivent être insérées s'appelle [Données].
Maintenant, nous devons insérer par lots les photos de la table [Photo] dans la colonne B de la table [Données] en fonction des noms d'images dans la colonne A de la table [données]...
L'exemple d'animation est le suivant :
...
Pour implémenter une telle fonction, 3 lignes de code suffisent en fait.
Le code est le suivant :
Sub InsertPicFromSheet() Dim rngData As Range, rngPicName As Range For Each rngData In Range("a2", Cells(Rows.Count, 1).End(3)) Set rngPicName = Sheets("照片").Cells.Find(rngData.Value, , , xlWhole) '使用Find方法在照片表完整匹配姓名 If Not rngPicName Is Nothing Then rngPicName.Offset(0, 1).Copy rngData.Offset(0, 1) '如果有找到对应的姓名,则将照片复制粘贴到目标位置 Next End Sub
Mais...
Le plus gros problème avec le code ci-dessus est que la table de données contient déjà d'anciennes images sans les supprimer. Si vous exécutez le programme à plusieurs reprises, cela provoquera une accumulation de. images. Afin de résoudre ce problème, nous devons ajouter deux phrases de code.
Le code est modifié comme suit :
Sub InsertPicFromSheet() Dim shp As Shape, rngData As Range, rngPicName As Range For Each shp In ActiveSheet.Shapes '删除活动工作表原有照片 If shp.Type = 13 Then shp.Delete Next For Each rngData In Range("a2", Cells(Rows.Count, 1).End(3)) Set rngPicName = Sheets("照片").Cells.Find(rngData.Value, , , xlWhole) '使用Find方法在照片表的完整匹配姓名 If Not rngPicName Is Nothing Then rngPicName.Offset(0, 1).Copy rngData.Offset(0, 1) '如果有找到对应的姓名,则将照片复制粘贴到目标位置 Next End Sub
Le code ci-dessus utilise une approche unique pour supprimer les anciennes images.
Mais...
Bien que ce code soit suffisant pour résoudre la plupart des problèmes des amis ayant une bonne base VBA, avec de légères modifications, il n'est évidemment pas assez convivial pour les novices...
Par exemple...
1. Le nom de la photo est fixé dans la colonne A du tableau de données. En réalité, il ne s'agit probablement pas de la colonne A. J'ai raison.
2. L'emplacement où la photo est placée est fixe dans la cellule où la colonne de nom est déplacée d'une colonne vers la droite. Dans la situation réelle, bien sûr, ce n'est peut-être pas le cas.
3. La feuille de calcul qui stocke les photos est définie sur feuilles ("photos") dans le code. En réalité, ce n'est certainement pas le cas...
4. les cellules pour s'adapter aux images. Taille, je...
Le code est modifié comme suit :
Sub InsertPicFromSheet2() 'ExcelHome VBA编程学习与实践 by:看见星光 Dim rngData As Range, rngWhere As Range, cll As Range Dim rngPicName As Range, rngPic As Range, rngPicPaste As Range Dim shp As Shape, sht As Worksheet, bln As Boolean Dim strWhere As String, strPicName As String, strPicShtName As String Dim x, y As Long, lngYesCount As Long, lngNoCount As Long 'On Error Resume Next Set rngData = Application.InputBox("请选择应插入图片名称的单元格区域", Type:=8) '用户选择需要插入图片的名称所在单元格范围 Set rngData = Intersect(rngData.Parent.UsedRange, rngData) 'intersect语句避免用户选择整列单元格,造成无谓运算的情况 If rngData Is Nothing Then MsgBox "选择的单元格范围不存在数据!": Exit Sub strWhere = InputBox("请输入放置图片偏移的位置,例如上1、下1、左1、右1", , "右1") '用户输入图片相对单元格的偏移位置 If Len(strWhere) = 0 Then Exit Sub x = Left(strWhere, 1) '偏移的方向 If InStr("上下左右", x) = 0 Then MsgBox "你未输入偏移方位。": Exit Sub y = Val(Mid(strWhere, 2)) '偏移的值 Select Case x Case "上" Set rngWhere = rngData.Offset(-y, 0) Case "下" Set rngWhere = rngData.Offset(y, 0) Case "左" Set rngWhere = rngData.Offset(0, -y) Case "右" Set rngWhere = rngData.Offset(0, y) End Select strPicShtName = InputBox("请输入存放图片的工作表名称", , "照片") For Each sht In Worksheets If sht.Name = strPicShtName Then bln = True Next If bln <> True Then MsgBox "未找到保存图片的工作表:" & strPicShtName & vbCrLf & "程序退出。": Exit Sub Application.ScreenUpdating = False rngData.Parent.Select For Each shp In ActiveSheet.Shapes '如果旧图片存放在目标图片存放范围则删除 If Not Intersect(rngWhere, shp.TopLeftCell) Is Nothing Then shp.Delete Next x = rngWhere.Row - rngData.Row y = rngWhere.Column - rngData.Column '偏移的纵横坐标 For Each cll In rngData '遍历选择区域的每一个单元格 strPicName = cll.Text '图片名称 If Len(strPicName) Then '如果单元格存在值 Set rngPicName = Sheets(strPicShtName).Cells.Find(cll.Value, , , xlWhole) '使用Find方法在照片表完整匹配姓名 If Not rngPicName Is Nothing Then Set rngPicPaste = cll.Offset(x, y) '粘贴图片的单元格 Set rngPic = rngPicName.Offset(0, 1) '保存图片的单元格 lngYesCount = lngYesCount + 1 '累加找到结果的个数 If lngYesCount = 1 Then '设置放置图片单元格的行高和列宽,以适应图片的大小 rngPicPaste.RowHeight = rngPic.RowHeight rngPicPaste.ColumnWidth = rngPic.ColumnWidth End If rngPicName.Offset(0, 1).Copy rngPicPaste '如果有找到对应的姓名,则将照片复制粘贴到目标位置 Else lngNoCount = lngNoCount + 1 '累加未找到结果的个数 End If End If Next Application.ScreenUpdating = True MsgBox "共处理成功" & lngYesCount & "个对象,另有" & lngNoCount & "个非空单元格未找到对应的图片名称。" End Sub
Le code ci-dessus résout les trois problèmes courants que nous avons mentionnés plus tôt...
Cependant...Trois, mais. ..
Il y a encore quelques problèmes qui peuvent survenir dans les applications pratiques. Non résolus...
Par exemple...
1. Comment résoudre le lien entre les images et les sources de données ? Lorsque l'image de la source de données change, l'image de la table de données change également automatiquement ? Eh bien, en plus de réexécuter le programme, vous pouvez également utiliser l'événement d'activation de la feuille de calcul, ou utiliser activesheet.chartobjects.add...
2. Comment définir la taille de l'image pour qu'elle s'adapte à la cellule. d'ajuster la taille de la cellule pour l'adapter à l'image ?
Recommandations d'apprentissage associées : Tutoriel Excel
Ce qui précède est le contenu détaillé de. pour plus d'informations, suivez d'autres articles connexes sur le site Web de PHP en chinois!