[[20101013081455]]　『写真の挿入』（64歳老人）　ページの最後に飛ぶ

『写真の挿入』（64歳老人）

 デジカメでとつた写真をエクセルに挿入してプリントしていますが、
 写真がとても大きくて、挿入するときに30％ぐらいで挿入できる方法がありますか？。
 方法があれば教えてくださいお願いします。エクセル2003です。

 私が使っている方法ですが、アドインを作ってしまうのはどうでしょうか？

 新規ブックを開きます。
 Alt + F11　でVisualBasicEditorを開きます。
 メニューの「挿入」→「標準モジュール」
 開いた白い画面に以下のコードを貼り付け
 VisualBasicEditorを閉じます。
 Excelの「ファイル」→「名前をつけて保存」で
 「ファイルの種類」を Microsoft Office Excel アドイン(*.xla)を選択します。
 保存場所はそのままで、適当な名前をつけて保存。
 Excelを閉じて、再度起動します。
 メニューの「ツール」→「アドイン」を開いて
 先ほど保存したファイル名のアドインにチェックを入れてOKを押します。
 再度Excelを閉じて開きなおしてみてください。

 セルの範囲を適当に選択して右クリックすると一番下に
 「選択範囲に写真挿入」というのが出来ているはずなのでそれを選択。
 すると、選択範囲の大きさに合わせて写真が張り付きます。

 '＝＝＝＝＝＝＝＝　以下コード　＝＝＝＝＝＝＝＝

  Private Sub Auto_Open()
  AddRightMenu
  End Sub

  Private Sub Auto_Close()
  DelRightMenu
  End Sub

  Private Sub AddRightMenu()
  Dim RightMenu As Object, i As Integer, r As Integer, BufID(1 To 6) As Long
  Get_ControlID BufID
  For i = 1 To 6
    With Application.CommandBars(BufID(i))
      Set RightMenu = .Controls.Add(Type:=msoControlButton, temporary:=False)
      With RightMenu
        .Caption = "選択範囲に写真挿入"
        .OnAction = "PastPic"
      End With
    End With
  Next i
  End Sub

  Private Sub DelRightMenu()
  Dim BufID(1 To 6) As Long, i As Long
  Get_ControlID BufID
  For i = 1 To 6
    Application.CommandBars(BufID(i)).Reset
  Next i
  End Sub

  Private Sub Get_ControlID(IDs() As Long)
  Dim c As CommandBar, i As Long
  For Each c In Application.CommandBars
    If c.Name = "Cell" Or c.Name = "Column" Or c.Name = "Row" Then
      i = i + 1
      IDs(i) = c.Index
    End If
  Next c
  End Sub

  Private Sub PastPic()
  Dim ht As Double, hl As Double, hh As Double, hw As Double
  Dim ih As Double, iw As Double
  Dim fn As String
  If TypeName(Selection) <> "Range" Then Exit Sub
  With Selection
    ht = .Top
    hl = .Left
    hh = .Height
    hw = .Width
  End With
  fn = Application.GetOpenFilename("写真ファイル(*.jpg),*.jpg", Title:="貼りつける写真を選択してください。")
  If fn = "False" Then Exit Sub
  With ActiveSheet.Pictures.Insert(fn)
    If .Height > hh Then
      ih = .Height
      .ShapeRange.ScaleHeight hh / ih, msoFalse
      .ShapeRange.ScaleWidth hh / ih, msoFalse
    End If
    If .Width > hw Then
      iw = .Width
      .ShapeRange.ScaleHeight hw / iw, msoFalse
      .ShapeRange.ScaleWidth hw / iw, msoFalse
    End If
    .Top = ht + hh / 2 - .Height / 2
    .Left = hl + hw / 2 - .Width / 2
  End With
  End Sub

 '＝＝＝＝＝＝＝＝　ここまで　＝＝＝＝＝＝＝＝

 （ｍｏｍｏ）

 ｍｏｍｏさんありがとうございます、出来ました。　　64歳老人

コメント返信：

[ 一覧(最新更新順) ]

[[20101013081455]] 『写真の挿入』（64歳老人） ページの最後に飛ぶ

[[20101013081455]]　『写真の挿入』（64歳老人）　ページの最後に飛ぶ