画像の差し込み印刷(エクセル)其のニ

 ★ 今回はPDFで出力するように変更 ★ 
 どうもこんばんわ阿良々木(アラクリカエシキ)です。
 このまえ掲載したエクセルの差し込み印刷の記事では開始番号と終了番号を指定して印刷しましたが、職場で使っているものは一端PDFで出力しています。なので、そのサンプルも紹介してみます。
 エクセルファイルと同じ場所に「PDF」と言うフォルダを作成し。コードを前回のものから下記のように変更します。
 PDF化は「マクロの記録」で普通にPDFで保存する作業を記録し、「filename:=」の部分を書き換えれば思ったより簡単にできるので皆さんも試してみてください。
'標準モジュール
Option Explicit
'-----------------------------------------------------------------------------
Sub LP()
Dim picst As String
Sheets("TEMP").Image1.Picture = LoadPicture("") 'img初期化
picst = ThisWorkbook.Path & "\PIC\" & Right("00" & _
Sheets("TEMP").Range("B1"), 2) & ".jpg"
If Dir(picst) = "" Then
Sheets("TEMP").Image1.Picture = LoadPicture("")
Else
Sheets("TEMP").Image1.Picture = LoadPicture(picst)
End If
End Sub
'------------------------------------------------------------------------------
Sub toPDF()
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\PDF\" & Right("00" & _
Sheets("TEMP").Range("B1"), 2) & ".PDF", Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
End Sub
'シートモジュール
'------------------------------------------------------------------------------
Option Explicit
'------------------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim bangou, a, n As Long
Dim picst As String
a = Range("F1").Value '開始番号
n = Range("H1").Value '
For bangou = a To n
DoEvents
Range("B1").Value = bangou
Call LP  ’←画像を切り替える
DoEvents
Call toPDF ' ←PDFで出力する。
DoEvents
'ActiveWindow.SelectedSheets.PrintOut ’今回はコメントアウト
Next bangou
End Sub
'------------------------------------------------------------------------------
ブログランキング・にほんブログ村へ
にほんブログ村
スポンサーサイト

画像の差し込み印刷(エクセル)


 どうもこんばんわ、水槽がエライ事になってほかのことを考えようとしてエクセルのVBAをいじっていた阿良々木です。
 皆さんはエクセルのVLOOKUP関数を使って帳票を作成したりしたことありませんか?
 それで、画像も差し込めたらいいとか考えたことありませんでしょうか?僕はあります。
 ワードの差し込み印刷でも同じようなこと出来るみたいですけど、しっくりきませんでした。
 なので、下のようなコードを組んでみました。

標準モジュール ※画像切り替え用

Sub LP()
Dim picst As String
Sheets("TEMP").Image1.Picture = LoadPicture("") 'img初期化
picst = ThisWorkbook.Path & "\PIC\" & Right("00" & _
Sheets("TEMP").Range("B1"), 2) & ".jpg"
If Dir(picst) = "" Then
Sheets("TEMP").Image1.Picture = LoadPicture("")
Else
Sheets("TEMP").Image1.Picture = LoadPicture(picst)
End If
End Sub

スピンボタンやコマンドボタン
Option Explicit

Private Sub SpinButton1_Change()
Call LP
End Sub

Private Sub CommandButton1_Click()
Dim bangou, a, n As Long
Dim picst As String
a = Range("F1").Value '開始番号
n = Range("H1").Value '終了番号
For bangou = a To n
DoEvents
Range("B1").Value = bangou
Call LP
DoEvents
ActiveWindow.SelectedSheets.PrintOut
Next bangou
End Sub

 え~では、まず、ブックをひとつ作成、同一階層に「PIC」というフォルダを作成し、01.jpg~10.jpgの画像を用意しておきます。
 次に、えーとシート「TEMP」にImage1を配置します。それから
 え~っと(´Д`;) 詳しく説明すると長くなるのでここで終り((゚Д゚)ノ)
 いやいや
 じゃあ簡単に
 シート「LIST」の表をVLOOKUP関数で参照、LP(LoadPictureの略)をCallで呼び出しImage1の画像を切り替えます。以上です。
 うーん(゜レ゜)いいのかこれで(´Д`;)
 もし、使ってみたいけど使い方がわからないという方がいらっしゃいましたらコメントお願いします。
 そういえば、ここ(FC2ブログ)って画像や動画以外、zipや.xlsmとかアップロートできるのでしょうか?
 ご存知の方コメントください。では(o・・o)/
 自己レス:http://blogfc2manual.blog.fc2.com/blog-entry-87.htmlにのってました。無理みたいですね。
 ■ シート名「TEMP」
sh1.jpg

 ■ シート名「LIST」
sh2.jpg

あっ、3が消えてる、まぁいいか

昔の自分に感心した(厭きれた)

 ★ WriteLine ★ 
 ご訪問ありがとうございます。阿良々木(アラクリカエシキ)です。
 今日は金曜日に引き続き送付状のエクセルファイルを弄ってみました。
 内容は別ファイルで作成するようにしていたテンプレートファイル(HTML形式)を送付状のファイルから直に作成するようにするというもの。
 使用するのはTextStreamオブジェクトのWriteLineメソッドで、参考にしたのはOfficeTANAKA先生の下記のページだったと思います。(随分昔に作ったので記憶は曖昧です…)

 http://officetanaka.net/excel/vba/filesystemobject/textstream13.htm
 
 ちなみに下は1年チョット前にそのファイルを作成していた頃の記事です。
 今回もコード載せようかと思ったんですが、とにかく長いコードなので…
 いや。難しいコードではないんですが、WriteLineメソッドでHTMLのタグやJavaScriptのコードも書いたりかなり力技なもので長いんですよ。

 http://arakurikaesiki.blog.fc2.com/blog-entry-135.html

 ↓こんな感じでCSSまで書き込んでます。(;・∀・)
 
WriteLine.jpg

 ↑昔の自分に感心したというか呆れてしまいます。ハァーこれまだ長いんですよ( ^ω^)・・・
 まあ、今日の作業は基本コピペで大半は済んだので見た目ほど手間がかかるわけではないんですけどね。
 それではまた・・・
  

ブログランキング・にほんブログ村へ
にほんブログ村

ドラッグ

 ★ ドラッグ アンド ドロップ ★ 
 ご訪問ありがとうございます。阿良々木(アラクリカエシキ)です。
 今日も職場でエクセルいじってました。この前はコピペ、エクセルのユーザーフォームで右クリックしたら「貼り付け」のメニューを表示するようしたのですが今日はクリップボードからテキストを取得し、ドラッグ アンド ドロップで編集できるように機能を一部変更してみました。
Private Sub CommandButton1_Click()

Dim ClipBoard As Variant

ClipBoard = Application.ClipboardFormats
'クリップボードが空か調べる。
If ClipBoard(1) = -1 Then
MsgBox "クリップボードは空です。"
Exit Sub
End If
'空じゃなかった場合
With New MSForms.DataObject
.GetFromClipboard
TextBox1.Value = .GetText
End With
Application.CutCopyMode = False

End Sub

 職場では気付かなかったのですが、記事を書くため自宅でコード打ってテストしていたら、下のような実行時エラーがヽ(´Д`;)ノ
ERROR.jpg
 こんな時は慌てずに(^。^)y-.。o○
 構造体が無効、ブログ用に画面コピーとってたらエラーが出たので
 「vba クリップボード 画像」で検索
 たどり着いたのがOfficeTANAKA先生のこのページ
 http://officetanaka.net/excel/vba/tips/tips20.htm
 サンプルコードを参考に下記のコードを追加、取り敢えずエラーはでなくなりました。( ゚д゚)ホッ!
If ClipBoard(1) = xlClipboardFormatBitmap Then
MsgBox "クリップボードの中身は画像です。"
Exit Sub
End If
 明日は職場でこの部分修正しようと思います。
 でも、あんまり時間かからないなぁ、なにしよっかなぁ
 憂鬱だなぁ
 考えても仕方がないですし、明日のことは明日考えようと思います。
 それではまた・・・ 

ブログランキング・にほんブログ村へ
にほんブログ村

コピペ

 ★ 右クリック ★ 
 ご訪問ありがとうございます。阿良々木(アラクリカエシキ)です。
 今日は、一昨日一応完成させたエクセルファイルを試しに使ってみることにしました。
 やることは業務用システムを開いてデータをコピーエクセルに画面を切り替えてデータの貼り付け、それで気づいたのがUserFormに配置したテキストボックスは右クリックからショートカットメニューを表示して貼り付けができないこと。
 自分はショートカットキー(Ctrl+V)で十分な気もするのですが、「右クリックで貼り付けできないの?」という意見は出てきそうです。
 早速ネットで検索し素晴らしい記事を発見しました。(≧∇≦)/

 mi-yuとExcelさんの↓の記事を参考に作業開始。
 http://miyu-excel.seesaa.net/article/404902852.html
 下記のコードが上記のサンプルコードに比べ短いのは職場が個人の端末とネット閲覧用の端末が分けてあり又USBメモリの接続も制限されているので簡単にコピペできないためです。
 それに「貼り付け」に限定したほうが業務上都合が良いと判断しました。
 また、コピペでなく手打ちすると、VBEに入力候補が表示されるのでとても勉強になります。 
 

  標準モジュールに下記のコードを入力。

 Sub Right_Paste()
SendKeys "^V" '貼り付け
 End Sub

 Sub Right_Menu()
Dim myPopup As Variant

Set myPopup = Application.CommandBars.Add _
    (Position:=msoBarPopup, temporary:=True)

With myPopup
With .Controls.Add
.Caption = "貼り付け"
.OnAction = "Right_Paste"
.FaceId = 22
End With
.ShowPopup
.Delete
End With

Set myPopup = Nothing

 End Sub

 フォームのモジュールに下記コードを入力。

 Private Sub TextBox1_MouseUp(-略-)
  '右クリックしたらメニューを表示
  If Button = 2 Then
  Right_Menu
  End If
 End Sub

 

 上ではTextBox1だけですが実際にはもっと沢山あり一手間でした。
 そんなわけで、二つの意味でコピペしたいけど出来ない一日でした。
 それではまた(o・・o)/~ 

ブログランキング・にほんブログ村へ
にほんブログ村
訪問者数
プロフィール

arakurikaesiki

Author:arakurikaesiki
阿良々木(あらくりかえしき)と申します。趣味はビオトープとアクアリウム、好きな小説は物語シリーズです。あと、仕事で楽したい(良く言えば効率化)ためにExcelやAccessでVBAをちょくちょくいじってます。
 当ブログはリンク大歓迎です。ブロともも絶賛募集中!

最新記事
カテゴリ
カレンダー
06 | 2018/07 | 08
1 2 3 4 5 6 7
8 9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31 - - - -
アクセスランキング
[ジャンルランキング]
アニメ・コミック
1278位
アクセスランキングを見る>>

[サブジャンルランキング]
アニメ
580位
アクセスランキングを見る>>
最新コメント
ミナミヌマエビ
にほんブログ村(ビオトープ)
にほんブログ村
月別アーカイブ
リンク(リンクフリー、大歓迎です)
RSSリンクの表示
ブロとも絶賛募集中

この人とブロともになる