Excel で写真を名前で簡単にクエリする方法

WBOY
リリース: 2022-07-12 11:58:16
転載
4986 人が閲覧しました

この記事では、excel に関する関連知識を提供します。主に、あるワークシートから別のワークシートに画像を挿入する方法など、名前で画像をクエリする方法に関する関連問題をまとめています。画像名に基づくワークシートデータテーブルのA列に写真を挿入する、写真テーブルの写真をデータテーブルのB列に一括挿入するなど、一緒に見ていきましょう。

Excel で写真を名前で簡単にクエリする方法

関連する学習の推奨事項: excel チュートリアル

あるワークシートから別のワークシートに画像を挿入するにはどうすればよいですか?例えば。

以下に示すように:

Excel で写真を名前で簡単にクエリする方法

ワークブックには 2 つのワークシートがあります。

写真を保存するワークシートの名前は [写真]、写真を挿入する必要があるワークシートの名前は [データ] です。

次に、[データ] テーブルの列 A の写真名に基づいて、[写真] テーブルの写真を [データ] テーブルの列 B にバッチ挿入する必要があります...

サンプルアニメーションは次のとおりです。

Excel で写真を名前で簡単にクエリする方法

....

このような機能を実現するには、実際には 3 行のコードで十分です。

コードは次のとおりです:

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
ログイン後にコピー

ただし...

上記のコードの最大の問題は、データ テーブルが古い画像を削除しないことです。プログラムが繰り返し実行されると、画像は累積的に表示されます。この問題を解決するには、さらに 2 行のコードを追加する必要があります。

コードは次のように変更されます。

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
ログイン後にコピー

上記のコードは、万能のアプローチを使用して古いイメージを削除します。

しかし...

このコードは、VBA の基礎を十分に積んだ友人にとっては、わずかな修正でほとんどの問題に対処できるのに十分ですが、初心者にとっては、明らかに十分にフレンドリーではありません...

例...

1. 写真の名前はデータ テーブルの A 列に固定されていますが、実際には A 列ではない可能性があります。

2. 写真の配置位置は、名前列を1列右に移動したセルで固定されていますが、もちろん実際にはそうでない場合もあります。まだ正しい。

3. 写真を保存するワークシートは、コード内でシート (「写真」) に固定的に設定されています。実際には、これは絶対に当てはまりません。私は賢明です...

4コードが設定されていません。セルのサイズは画像のサイズに合わせて調整されます。I...

コードは次のように変更されます:

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
&#39;如果旧图片存放在目标图片存放范围则删除
If Not Intersect(rngWhere, shp.TopLeftCell) Is Nothing Then shp.Delete
Next
x = rngWhere.Row - rngData.Row
y = rngWhere.Column - rngData.Column
&#39;偏移的纵横坐标
For Each cll In rngData
&#39;遍历选择区域的每一个单元格
strPicName = cll.Text
&#39;图片名称
If Len(strPicName) Then
&#39;如果单元格存在值
Set rngPicName = Sheets(strPicShtName).Cells.Find(cll.Value, , , xlWhole)
&#39;使用Find方法在照片表完整匹配姓名
If Not rngPicName Is Nothing Then
Set rngPicPaste = cll.Offset(x, y)
&#39;粘贴图片的单元格
Set rngPic = rngPicName.Offset(0, 1)
&#39;保存图片的单元格
lngYesCount = lngYesCount + 1
&#39;累加找到结果的个数
If lngYesCount = 1 Then
&#39;设置放置图片单元格的行高和列宽,以适应图片的大小
rngPicPaste.RowHeight = rngPic.RowHeight
rngPicPaste.ColumnWidth = rngPic.ColumnWidth
End If
rngPicName.Offset(0, 1).Copy rngPicPaste
&#39;如果有找到对应的姓名,则将照片复制粘贴到目标位置
Else
lngNoCount = lngNoCount + 1
&#39;累加未找到结果的个数
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "共处理成功" & lngYesCount & "个对象,另有" & lngNoCount & "个非空单元格未找到对应的图片名称。"
End Sub
ログイン後にコピー

上記のコードは、先ほど述べた 3 つの一般的な問題...

Ran...3 つですが...

実際のアプリケーションで発生する可能性のある未解決の問題がまだいくつかあります...

例...

1. 画像とデータソース連携の問題を解決するにはどうすればよいですか?データソースの画像が変更されると、データテーブルの画像も自動的に変更されますか?プログラムを再実行するだけでなく、ワークシートのアクティベーション イベントを使用したり、activesheet.chartobjects.add...

2. 画像のサイズを適切に設定する方法セルのサイズを調整するのではなく、セルを画像に合わせますか?

関連する学習の推奨事項: Excel チュートリアル

以上がExcel で写真を名前で簡単にクエリする方法の詳細内容です。詳細については、PHP 中国語 Web サイトの他の関連記事を参照してください。

関連ラベル:
ソース:excelhome.net
このウェブサイトの声明
この記事の内容はネチズンが自主的に寄稿したものであり、著作権は原著者に帰属します。このサイトは、それに相当する法的責任を負いません。盗作または侵害の疑いのあるコンテンツを見つけた場合は、admin@php.cn までご連絡ください。
人気のチュートリアル
詳細>
最新のダウンロード
詳細>
ウェブエフェクト
公式サイト
サイト素材
フロントエンドテンプレート