Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 7 Professional : Excel 2007)
画像を貼り付ける前に元のリンクを消すマクロ
投稿日時: 18/03/02 14:50:27
投稿者: コウキ 大平

下記のマクロで画像の貼り付けを行いたいのですが、貼り付ける前にあるAU列のリンクが邪魔なので、消したいのですが、方法が分かりません。
タイミングは下記のマクロが実行されるときに消してから貼り付ける形が良いのですが、うまくマクロを組み込めません。
  
皆さんの知恵をお貸しください。
  
以下、マクロ
  
Sub 画像ボタン_Click()
  Dim Pic As String, PHT As Single, PWD As Single
  Dim CTP As Single, CLF As Single, CHT As Single, CWD As Single
  Dim shp As Object
  Dim rng As Range
   
   
  With CreateObject("WScript.Shell")
   
   
  .CurrentDirectory =
End With
   
   
   
  Dim chk As Variant
  Pic = Application.GetOpenFilename
  If Pic = "False" Then Exit Sub
  Application.ScreenUpdating = False
   
  With Sheets("原紙")
  .Activate
  CTP = .Range("K10:AE23").Top 'セル範囲の上辺位置
CLF = .Range("K10:AE23").Left 'セル範囲の左辺位置
CHT = .Range("K10:AE23").Height 'セル範囲の高さ
CWD = .Range("K10:AE23").Width 'セル範囲の幅
'指定セル範囲にある画像を削除
For Each shp In ActiveSheet.Pictures
  If shp.Left >= CLF And shp.Top >= CTP Then
  shp.Delete
  End If
  Next shp
  .Pictures.Insert(Pic).Select
  With Selection.ShapeRange
  PHT = .Height '写真の縦サイズ
PWD = .Width '写真の横サイズ
.LockAspectRatio = msoTrue
  Select Case PHT / PWD '写真の縦/横比と比べて、
Case Is >= CHT / CWD 'セル範囲の縦/横比が小さい
.Height = CHT
  PWD = Selection.ShapeRange.Width '拡縮時の横サイズ
.Top = CTP
  .Left = CLF + (CWD - PWD) / 2
  Case Else 'セル範囲の縦/横比が大きい
.Width = CWD
  PHT = Selection.ShapeRange.Height '拡縮時の縦サイズ
.Top = CTP + (CHT - PHT) / 2
  .Left = CLF
  End Select
  End With
  End With
  'Sheets("F6一覧表").Activate
  Sheets("原紙").Activate
  With sh
  Set rng = .Range("C6:C" & .Cells(Rows.Count, "C").End(xlUp).Row)
  chk = Application.Match(TextBox1.Text, rng, 0)
  If IsError(chk) Then
  chk = .Cells(Rows.Count, "C").End(xlUp).Row + 1
  Else
  chk = chk + 5
  End If
  .Range("AU" & chk).Value = Mid(Pic, InStrRev(Pic, "\") + 1)
  .Range("AU" & chk).Hyperlinks.Add Anchor:=.Range("AU" & chk), Address:=Pic
  End With
  Application.ScreenUpdating = True
  Image1.Picture = LoadPicture(Pic)
  End Sub

回答
投稿日時: 18/03/02 16:13:36
投稿者: Suzu

ハイパーリンクを削除するコマンドを知りたいのでしょうか。
 
そうであれば、マクロの記録でハイパーリンクを削除してみれば参考コードが得られるでしょう。

投稿日時: 18/03/05 16:24:10
投稿者: コウキ 大平

ご回答ありがとうございます。
このマクロ自体が一覧表から検索をかけて、呼び出したデータを書き換えるものなので、呼び出したデータのもとを書き換えたいです。
 
マクロの記録でコードを得たとしてもどこに書き込むのかわからないです。
このマクロに組み込むことは可能でしょうか?

回答
投稿日時: 18/03/05 17:30:47
投稿者: Suzu

引用:
一覧表から検索をかけて、呼び出したデータを書き換えるものなので
呼び出したデータのもとを書き換えたいです。
マクロの記録でコードを得たとしてもどこに書き込むのかわからないです。
このマクロに組み込むことは可能でしょうか?

 
可能か可能でないか と問われれば、可能でしょう。
 
シングルステップ で Excel上で起こる事を追ってゆけば、
このコードの命令で こういう事をさせているんだな。 と言うのは判ると思いますよ。
 
質問者の コウキ 大平 さんは、このコードを知ろうと何をなされたんでしょうか。
ただ、コード くれくれ というのであれば失礼いたします。

投稿日時: 18/03/05 17:46:52
投稿者: コウキ 大平

マクロの記録で実行し、多少書き換え、コードを作りましたが、エラーが出ます。

 Range("AU" & chk).Hyperlinks.Delete
   Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
   ActiveCell.FormulaR1C1 = ""
  
 .Range("AU" & chk).Value = Mid(Pic, InStrRev(Pic, "\") + 1)
 .Range("AU" & chk).Hyperlinks.Add Anchor:=.Range("AU" & chk), Address:=Pic
  
 End With
 Application.ScreenUpdating = True
 Image1.Picture = LoadPicture(Pic)
 End Sub
  
 

回答
投稿日時: 18/03/05 18:53:27
投稿者: Suzu

マクロの自動記録で得られるのは、ワークシート上の操作です。
 
ご提示のコードも、そうなっています。
 

引用:
Range("AU" & chk).Hyperlinks.Delete
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
ActiveCell.FormulaR1C1 = ""

 
このコードで実行したいのは、なんでしょうか。
 
流れは、
 
セル AU & chk の
 1)ハイパーリンクの削除
 2)ハイパーリンクを開く
 3)セルの表示をクリア
で良いのでしょうか。
 
With Range("AU" & chk)
   .Hyperlinks.Delete
   .Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
   .FormulaR1C1 = ""
End With
 
なんですが、
 1で、ハイパーリンクを削除していますから
 2の ハイパーリンクを開く段階で、ハイパーリンクが無くなっていますので怒られます。
 
  1と、2の間で、ハイパーリンクを設定してください。
   (モーグを開くハイパーリンクなら下の様な感じ。)
  .Hyperlinks.Add .Cells, "http://www.moug.net"
 
 3.の操作は、意図している動作では無い気がしますが、その辺りはご自身で修正下さい。

投稿日時: 18/03/06 08:09:36
投稿者: コウキ 大平

違うコードの改良で動作確認できました。
 
ありがとうございました!