こんにちは。
会社で写真台帳を作成しています。
以下のVBAだと横2列の写真台帳になりますが、
これを横3列の写真台帳にしたいと思っていますが、
どのようにすればよいのでしょうか?
このマクロは以前、会社にいた人が作ったらしいのですが、
その後退職してしまい、だれもマクロの内容が分からず困っています。
よろしくお願いします。

Sub 写真台帳()

Dim strFilter As String
Dim Filenames As Variant
Dim PIC As Picture

' 「ファイルを開く」ダイアログでファイル名を取得
strFilter = "画像ファイル(*.jpg;*.jpeg;*.gif;*.bmp;*.png),*.jpg;*.jpeg;*.gif;*.bmp;*.png"
Filenames = Application.GetOpenFilename( _
FileFilter:=strFilter, _
Title:="図の挿入(複数選択可)", _
MultiSelect:=True)
If Not IsArray(Filenames) Then Exit Sub

' ファイル名をソート
Call BubbleSort_Str(Filenames, True, vbTextCompare)

' 貼り付け開始セルを選択
Range("A5").Select

' マクロ実行中の画面描写を停止
Application.ScreenUpdating = False
' 順番に画像を挿入
j = -1

For i = LBound(Filenames) To UBound(Filenames)

j = j + 1




Set PIC = ActiveSheet.Pictures.Insert(Filenames(i))

'-------------------------------------------------------------
' 画像の各種プロパティ変更
'-------------------------------------------------------------
With PIC
.Top = ActiveCell.Top ' 位置:アクティブセルの上側に重ねる
.Left = ActiveCell.Left ' 位置:アクティブセルの左側に重ねる
.Placement = xlMove ' 移動するがサイズ変更しない
.PrintObject = True ' 印刷する
End With
With PIC.ShapeRange
.LockAspectRatio = msoTrue ' 縦横比維持
' 画像の幅をアクティブセルにあわせる
' 結合セルの場合でも対応
.Width = ActiveCell.MergeArea.Width 'Height:高さに合わせる場合
End With

' 次の貼り付け先を選択(アクティブセルにする)[例:5個下のセル]



If j Mod 2 = 0 Then

ActiveCell.Offset(0, 1).Select


Else
ActiveCell.Offset(4, -1).Select

End If



Set PIC = Nothing
Next i

' 終了
Application.ScreenUpdating = True
MsgBox i - 1 & "枚の画像を挿入しました", vbInformation

End Sub

' バブルソート(文字列)
Private Sub BubbleSort_Str( _
ByRef Source As Variant, _
Optional ByVal SortAsc As Boolean = True, _
Optional ByVal Compare As VbCompareMethod = vbTextCompare)

If Not IsArray(Source) Then Exit Sub

Dim i As Long, j As Long
Dim vntTmp As Variant
For i = LBound(Source) To UBound(Source) - 1
For j = LBound(Source) To LBound(Source) + UBound(Source) - i - 1
If StrComp(Source(IIf(SortAsc, j, j + 1)), _
Source(IIf(SortAsc, j + 1, j)), Compare) = 1 Then
vntTmp = Source(j)
Source(j) = Source(j + 1)
Source(j + 1) = vntTmp
End If
Next j
Next i

End Sub

このQ&Aに関連する最新のQ&A

A 回答 (1件)

変更場所は下記2点です。


> If j Mod 2 = 0 Then
→ If j Mod 3 <> 2 Then

> ActiveCell.Offset(4, -1).Select
→ ActiveCell.Offset(4, -2).Select
    • good
    • 0
この回答へのお礼

ありがとうございました。なんとかできました。

もうひとつあるのですが、画像をセルの真ん中に貼り付けるときはどのようにすればよいのでしょうか?
引き続きよろしくお願いします。

お礼日時:2009/05/15 15:55

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Qエクセル プルダウンの作り方

お世話になります。
エクセルでプルダウンの作り方を教えていただけませんでしょうか?
住所を▼のボタンでクリックしたら【北海道,青森,秋田,岩手・・・】などの選択ができるようにしたいのです。
宜しくお願いします。

Aベストアンサー

メニューから「データ」、「入力規則」、「設定」で「入力値の種類」を「リスト」を選択します。
そうすると「元の値」という表示がでますので、そこで前もって作っておいたリストの範囲を指定します。
多くないのでしたら、そのままそこにカンマで区切って入力しても出来ます。

Q=IF('[国語.xls]5段階'!R9C5=A,

=IF('[国語.xls]5段階'!R9C5=A,"○","")のように
入力すると、#NAME?で返されます。
どこが間違っているのでしょうか?
どなたか教えてください。
評価がA,B,Cのうち、Aの時だけ
○がつくようにしたいのです。

Aベストアンサー

=IF('[国語.xls]5段階'!R9C5=A,"○","")
              ↓

=IF('[国語.xls]5段階'!R9C5="A","○","")

Qエクセルでプルダウンメニューの作り方

  エクセルの画面で、よく三角形を逆さまにした形をクリックするといくつかメニューが出てき、どれかを選べるようになっていますが、その作り方を教えてください。
 会社で人事を担当していますが、三角形(プルダウンボタン)をクリックすると社員氏名一覧が表示され、そこから選択できるようにしたいのです。
 しばらく自力でいろいろやってみましたが、さっぱり見当がつかず、どうやればいいのか分かりませんでした。よろしくお願いします。

Aベストアンサー

こんばんは!
当方使用のExcel2003での一例です!

↓の画像のようにSheet2に名簿表を作成しておきます。
画像ではSheet2のA2セル以降を範囲指定 → 名前ボックスに仮に「名簿」と入力しOK
これで範囲指定したセルが「名簿」と名前定義されましたので、

Sheet1のリスト表示させたいセルを範囲指定 → メニュー → データ → 入力規則
→ リスト → 「元の値」の欄に
=名簿
としてOK

これでSheet1のセルをアクティブにすると右側に下向き▼が表示されますので、そこをクリック!
これで希望に近い形にならないでしょうか?
Excel2007の場合は↓のURLが参考になるかもしれません。

http://www.eurus.dti.ne.jp/~yoneyama/Excel2007/excel2007-ny_kis2.html

尚、同一Sheetに「名簿表」を作成する場合は名前定義する必要はなくて
「元の値」の右側の四角をクリックし、リスト表示したいセルをそのまま範囲指定すればOKです。

以上、お役に立てば良いのですが・・・m(_ _)m

こんばんは!
当方使用のExcel2003での一例です!

↓の画像のようにSheet2に名簿表を作成しておきます。
画像ではSheet2のA2セル以降を範囲指定 → 名前ボックスに仮に「名簿」と入力しOK
これで範囲指定したセルが「名簿」と名前定義されましたので、

Sheet1のリスト表示させたいセルを範囲指定 → メニュー → データ → 入力規則
→ リスト → 「元の値」の欄に
=名簿
としてOK

これでSheet1のセルをアクティブにすると右側に下向き▼が表示されますので、そこをクリック!
これで希望に近い形にならない...続きを読む

QWorksheets.Count の場合 Dim i As Byte ではいけませんか?

Office XP Personal 2002
Excel 2002

今まで、メモリ等をそれほど気にしなくて使用してきましたが、
下記の 1 のほうが、メモリを使わないのでよろしいかと思いますが、
どうなんでしょうか?
それとも、もっと他のことで、メモリの節約をしたほうがよろしいでしょうか。
(シートを256枚以上も使用することはありませんので)
(他の質問等をみても、Byte は、ほとんど見かけないように思いましたので)

初歩的な質問かと思われますが、
よろしくお願い致します。

'1
Dim i As Byte   '1バイト
'2
Dim i As Integer '2バイト

For i = 1 To Worksheets.Count - 1

Aベストアンサー

Byte で、特に問題は無いと思いますが、

メモリーの節約が目的なら、これで節約できるメモリーは1バイトです
PCのメモリーが数百メガ~数ギガバイトもあるという現状では、あまり意味が無いと思います
影響が有るとすれば、
配列変数で、何千万個も使用する場合とか...でしょうか

ループ変数として使用する場合でも、255回程度のループなら実行速度に影響は無いと思います

Qエクセル(Excel) 納品書の作り方【画像修正版

昨日http://oshiete.goo.ne.jp/qa/7348426.htmlで質問させていただき、詳しくご回答いただき少し進んだのですが、状況が変わったので改めて質問させていただきます。

■エクセル(Excel)で納品書の作成をしています。
シート1に納品書、シート2に商品マスタ(一覧)を作っていて、シート2の一覧を反映させて
納品書に番号を打ち込むだけで、商品名・単価までが出るシステムを作りたいのですが、
昨日のご回答の中の「VLOOKUP」?を入れて、自分なりにマス目の数字を変えてやってみたのですが
反映されずN/?のようなエラーになってしまいます。

※画像が見にくかったのでシート<CENTER></CENTER>だけにしました。

1、上記のように、シート2との関連付けの係数を、写真の場合の数字で教えてください。

2、合計と、合計から20%を引いた数値を割り出す関数も、写真の数字で御願いします。

宜しくご教授お願い致します。

Aベストアンサー

こんばんは!
前回投稿した者です。

当方もかなり古い(人間も古い!なぁ~んちゃって!)Excel2003を使用しています。
↓の画像のようにSheet2にデータを作成しておきます。

#N/A というエラーは、「検索値」がない!ということですので
お示しの画像のB列にSheet2のA列にないデータを入力するとそういったエラーが表示されます。

画像のセル配置ですと
C4セルに
=IF($B4="","",VLOOKUP($B4,Sheet2!$A:$C,COLUMN(B1),0))
(「$」マークの位置に気を付けてください)
という数式を入れD4セルまでオートフィルでコピー!
そのまま最後の24行目までコピーしておきます。

F4セルには
=IF(COUNTBLANK(B4:E4),"",D4*E4)
という数式を入れ、F24までオートフィルでコピー!

これでB列に商品番号を入力すればSheet2のデータが反映され、
E列に数量を入力でF列に金額が表示されると思います。

最後に合計金額のF26セルは
=IF(COUNT(F4:F24),SUM(F4:F24),"")
手数料のF27セルは
=IF(F26="","",F26*0.2)

これで何とか形にならないでしょうか?

※ 振込金額の欄は不明ですので手を付けていません。

参考になりますかね?m(_ _)m

こんばんは!
前回投稿した者です。

当方もかなり古い(人間も古い!なぁ~んちゃって!)Excel2003を使用しています。
↓の画像のようにSheet2にデータを作成しておきます。

#N/A というエラーは、「検索値」がない!ということですので
お示しの画像のB列にSheet2のA列にないデータを入力するとそういったエラーが表示されます。

画像のセル配置ですと
C4セルに
=IF($B4="","",VLOOKUP($B4,Sheet2!$A:$C,COLUMN(B1),0))
(「$」マークの位置に気を付けてください)
という数式を入れD4セルまでオートフィルで...続きを読む

QPublicで宣言した時は「End Sub」でマクロが終わっても変数は保存されるのですか?

Public test As Boolean
Sub マクロ1()
test = True
End Sub

をステップインでデバッグしながら実行する時に
一番最初はtestにカーソルをあてるとFalseなのですが
一度「End Sub」まで到達しもう一度「Sub マクロ1()」から始めると
test = True
を通過する前から
testにカーソルをあてるとTrueになります。
でもデバッグ中に四角ボタンで停止するとFalseに戻ります。
そもそもBoolean型の規定値はFalseですよね?
これはどういうことなのでしょうか?

ご教授よろしくお願いします。

Aベストアンサー

こんばんは。

今まで、そんなことは考えてみたことはありませんが、たぶん、確保した変数が、途中で止めることで、壊れてしまうのだと思いますね。ただ、どこにも、こんな話は書かれていないと思います。あえていうなら、不完全なマクロがあるようなプロジェクトでは、Public 変数は置けないということでしょう。

例えば、このようにしてエラーを発生させても、test の値は確保できません。

'--------------------------------------
'第一テスト

Public test As Boolean
Sub マクロ1()
  Dim a As Long
  test = True
  a = "A" '←エラーを発生させる
End Sub

''End Sub まで、来ないと値を確保できないのです。

'--------------------------------------
'第二テスト

Public test As Boolean
Sub マクロ1() '1
  MsgBox test
  test = True
End Sub

Sub マクロ2() '2
  Dim a As Long
  test = True
  a = "A" '←エラーを発生させる
End Sub

'1 --> 2 (エラー発生) -->3 で、チェックする。
'--------------------------------------
これで分かるのは、エラーが発生すると、今まで確保した値が飛んでしまうということです。
だから、必ず、On Error トラップで、最低でも、End Sub まで持ってこさせなくてはなりませんが、次の例の場合は、やはり、変数の値は確保できません。

'--------------------------------------
'第三テスト

Public test As Boolean
Sub マクロ3()
  MsgBox test
  test = True
  Call マクロ4
End Sub

Sub マクロ4()
  Dim a As Long
  On Error GoTo ErrHandler
  a = "A"
ErrHandler:
  If Err.Number > 0 Then
   End
  End If
End Sub

'マクロ3のみ
'--------------------------------------
以下の、コメントブロックして、マクロ3に戻って、End Sub をすれば、値は確保できます。
'  If Err.Number > 0 Then
'   End
'  End If

こんばんは。

今まで、そんなことは考えてみたことはありませんが、たぶん、確保した変数が、途中で止めることで、壊れてしまうのだと思いますね。ただ、どこにも、こんな話は書かれていないと思います。あえていうなら、不完全なマクロがあるようなプロジェクトでは、Public 変数は置けないということでしょう。

例えば、このようにしてエラーを発生させても、test の値は確保できません。

'--------------------------------------
'第一テスト

Public test As Boolean
Sub マクロ1()
  Dim a ...続きを読む

Qエクセル(Excel) 納品書の作り方【改めて】

昨日http://oshiete.goo.ne.jp/qa/7348426.htmlで質問させていただき、詳しくご回答いただき少し進んだのですが、状況が変わったので改めて質問させていただきます。

■エクセル(Excel)で納品書の作成をしています。
シート1に納品書、シート2に商品マスタ(一覧)を作っていて、シート2の一覧を反映させて
納品書に番号を打ち込むだけで、商品名・単価までが出るシステムを作りたいのですが、
昨日のご回答の中の「VLOOKUP」?を入れて、自分なりにマス目の数字を変えてやってみたのですが
反映されずN/?のようなエラーになってしまいます。

※画像が貼り付けてあります。商品名は1番以外伏せさせていただいています。
くっつけてありますが、左側がシート1・右側がシート2です。

1、上記のように、シート2との関連付けの係数を、写真の場合の数字で教えてください。

2、合計と、合計から20%を引いた数値を割り出す関数も、写真の数字で御願いします。

宜しくご教授お願い致します。

Aベストアンサー

画像がいまいちよく見えないのですが、納品書の項目は左から、No、商品番号、商品名、単価、数量、金額でいいのでしょうか(名前は多少違っていても意味があっていればもんだいないです)

でしたら、
C1セルに=IF(ISBLANK(B2),"",VLOOKUP(B2,Sheet2!$A$2:$C$200,2,FALSE))
D1セルに=IF(ISBLANK(B2),"",VLOOKUP(B2,Sheet2!$A$2:$C$200,3,FALSE))
E1セルは空白で
F1セルに=IF(D2="","",D2*E2)
といれて、C1からF1までをコピーしてその下の行にタテに貼り付ければ出来ますよ。
おそらくエラーが出たのは、コピーしたときにVLOOKUP関数の最初のセルの指定がずれてしまっているのでは無いかと思いますよ。     

Q'Cells'メソッドは失敗しました '_Global'オブジェクト

次のマクロですが、順調に動いていたと思うと
急にタイトルのエラーで落ちたりします。


Set mySh = Thisworkbook.Sheets("Sheet1")
Debug.Print mySh.Cells(1,1)

また、そのときは・・・

mySh.Rows("4:4").Select
Selection.Insert Shift:=xlDown



mySh.Select
Rows("4:4").Insert Shift:=xlDown



mySh.Rows("4:4").Insert Shift:=xlDown

もできなくなります。

オブジェクトへの参照方法が今ひとつわかっていないのですが、
どの場合でもエラーなく実行するにはどうすればいいのでしょうか?

Aベストアンサー

こんにちは。Wendy02です。

>Cells(4,4)に時刻が入っていて、Webから取得した文字列
うーん。余談にはなるのですが、最近、同じ系列の質問が多くなりましたね。

>    If Format(Cells(4, 4), "hh:mm") <> Format(myVal, "hh:mm") Then

まあ、ある程度、なれてくれば感覚的には分るのですが、Cells を唐突に用いるとエラーが発生する確率が高くなります。私も、経験ありますが、以前はさっぱり分らなかったです。Cellsも、Applicationに対するグローバルオブジェクトなのに、シートの属性をつけないといけないのですね。ちょっと、気をつけたほうがよいです。With ~.Cells と使います。こういうことも、一応「明示的(explicit)」といいます。

ちょっと、以下のもので研究してみてください。

'<標準モジュール推奨>

Sub Test2()
  Dim myTime1 As Variant
  Dim myTime2 As Variant
  Dim myVal As String
'  myVal = "15:30"
  With ThisWorkbook.Worksheets("ABC")
   If IsDate(.Cells(4, 4).Text) Then myTime1 = CDate(.Cells(4, 4).Text)
   If IsDate(myVal) Then myTime2 = CDate(myVal)
   If myTime1 <> Empty And myTime2 <> Empty Then
     If Format(myTime1, "hh:mm") <> Format(myTime2, "hh:mm") Then
      .Rows("4:4").Insert Shift:=xlDown
     End If
   End If
  End With
End Sub

こんにちは。Wendy02です。

>Cells(4,4)に時刻が入っていて、Webから取得した文字列
うーん。余談にはなるのですが、最近、同じ系列の質問が多くなりましたね。

>    If Format(Cells(4, 4), "hh:mm") <> Format(myVal, "hh:mm") Then

まあ、ある程度、なれてくれば感覚的には分るのですが、Cells を唐突に用いるとエラーが発生する確率が高くなります。私も、経験ありますが、以前はさっぱり分らなかったです。Cellsも、Applicationに対するグローバルオブジェクトなのに、シートの属性をつけな...続きを読む

Qエクセル2007でプルダウンで選んだものに反応

Excel2007でプルダウンで選んだものに反応して隣のセルが自動入力される方法(エクセル2007)
A1をプルダウンで「猫」「犬」から選べるようにし、「猫」を選んだ場合B1に自動に「111」が、「犬」を選んだ場合B1に自動に「222」と入力されるようにしたいです。
ご教授の程、宜しくお願いします。

Aベストアンサー

VLOOKUP関数での方法です。
(1)別シートに入力文字列と対応コード表を作成。(仮にSheet2のA:B列範囲で順不同)
(2)B1に=IF(COUNTIF(Sheet2!A:A,A1),VLOOKUP(A1,Sheet2!A:B,2FALSE),"")を設定
   入力文字列が存在しない場合は空白としています。

QVBAにて実行時エラー’1004’:「アプリケーション定義又はオブジェクト定義のエラー」発生?

VBA初心者です。Xp,Excel2000を使用しています。
シフト者のカレンダー作成しており、動作していたVBAのコピーを利用しています。
何回かループを回った後表記エラーとなります。アドバイスをお願いいたします。

  A B C D E
--------------------------
1 2 3 4 ...... <-- 日付
2 2 0 1 ...... <-- シフト(ln_1の範囲名)
7 8 9 10 ...... <-- 日付
1 0 3 3 ..... <-- シフト(ln_2の範囲名)
....................

For i = 1 To 6   <-- 最大6週にわたる
Set r = Range("ln_" & LTrim$(Str$(i)))
cpos = r.Column
rpos = r.Row
For n = 1 To r.Columns.Count
With Cells(rpos - 1, cpos + n - 1)
m = .Characters.Count <-- 数回ループ後ここでエラーとなる!
s = Cells(rpos, cpos + n - 1) <-- シフト情報
Select Case s
Case ""    '- Blank -
........ 日付セルの装飾

Case "0" '- Holiday -
......... 日付セルの装飾

Case "1" '- shift1 -
........... 日付セルの装飾

VBA初心者です。Xp,Excel2000を使用しています。
シフト者のカレンダー作成しており、動作していたVBAのコピーを利用しています。
何回かループを回った後表記エラーとなります。アドバイスをお願いいたします。

  A B C D E
--------------------------
1 2 3 4 ...... <-- 日付
2 2 0 1 ...... <-- シフト(ln_1の範囲名)
7 8 9 10 ...... <-- 日付
1 0 3 3 ..... <-- シフト(ln_2の範囲名...続きを読む

Aベストアンサー

よく調べてみたら、Characters.Countは、"ABC"などの文字列では3を返しますが、"123"ではエラーになり、数字ではだめなようです。セルの書式を文字列にしてもだめでした。

m = .Characters.Count は文字の数をお知りになりたいだけのようなので、以下のコードに換えて試してみてください。

m=Len(.value)

なお、MsgBox .Address などは、エラーのでるコードの前に挿入、という意味で書きました。
泥臭い方法ですが、コードがどのセルを参照しているのかわかるので、エラーがでる時などにはおすすめです。


人気Q&Aランキング

おすすめ情報